flash2.F90       coverage:  63.16 %func     39.81 %block


     1) module Flash2_module
     2)   
     3)   use Flash2_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-8
    38)   PetscReal, parameter :: dfac = 1.D-8
    39)   PetscReal, parameter :: floweps = 1.D-24
    40) !  PetscReal, parameter :: satcuteps = 1.D-5
    41)   PetscReal, parameter :: zerocut = 0.D0  !1D-8
    42)   
    43) 
    44)   PetscInt, parameter :: jh2o=1, jco2=2
    45) 
    46) ! PetscReal, allocatable, save :: Resold_AR(:,:), Resold_FL(:,:), delx(:,:)
    47)   
    48)   public Flash2Residual,Flash2Jacobian, &
    49)          Flash2UpdateFixedAccumulation,Flash2TimeCut,&
    50)          Flash2Setup,Flash2UpdateReason,&
    51)          Flash2MaxChange, Flash2UpdateSolution, &
    52)          Flash2GetTecplotHeader, Flash2InitializeTimestep, &
    53)          Flash2UpdateAuxVars, Flash2ComputeMassBalance, Flash2Destroy
    54) 
    55) contains
    56) 
    57) ! ************************************************************************** !
    58) 
    59) subroutine Flash2TimeCut(realization)
    60)   ! 
    61)   ! Resets arrays for time step cut
    62)   ! 
    63)   ! Author: Chuan Lu
    64)   ! Date: 9/13/08
    65)   ! 
    66)  
    67)   use Realization_Subsurface_class
    68)   use Option_module
    69)   use Field_module
    70)  
    71)   implicit none
    72)   
    73)   type(realization_subsurface_type) :: realization
    74)   type(option_type), pointer :: option
    75)   type(field_type), pointer :: field
    76)   
    77)   PetscReal, pointer :: xx_p(:),yy_p(:)
    78)   PetscErrorCode :: ierr
    79)   PetscInt :: local_id
    80) 
    81)   option => realization%option
    82)   field => realization%field
    83) 
    84) end subroutine Flash2TimeCut
    85) 
    86) ! ************************************************************************** !
    87) 
    88) subroutine Flash2Setup(realization)
    89)   ! 
    90)   ! Author: Chuan Lu
    91)   ! Date: 9/13/08
    92)   ! 
    93) 
    94)   use Realization_Subsurface_class
    95)   use Patch_module
    96)   use Output_Aux_module
    97) !  use span_wagner_module
    98) !  use co2_sw_module
    99) !  use span_wagner_spline_module 
   100)    
   101)   type(realization_subsurface_type) :: realization
   102)   
   103)   type(patch_type), pointer :: cur_patch
   104)   type(output_variable_list_type), pointer :: list
   105)  
   106)   cur_patch => realization%patch_list%first
   107)   do
   108)     if (.not.associated(cur_patch)) exit
   109)     realization%patch => cur_patch
   110)     call Flash2SetupPatch(realization)
   111)     cur_patch => cur_patch%next
   112)   enddo
   113) 
   114)   list => realization%output_option%output_snap_variable_list
   115)   call Flash2SetPlotVariables(list)
   116)   list => realization%output_option%output_obs_variable_list
   117)   call Flash2SetPlotVariables(list)
   118) 
   119) end subroutine Flash2Setup
   120) 
   121) ! ************************************************************************** !
   122) 
   123) subroutine Flash2SetupPatch(realization)
   124)   ! 
   125)   ! Creates arrays for auxiliary variables
   126)   ! 
   127)   ! Author: Chuan Lu
   128)   ! Date: 10/1/08
   129)   ! 
   130) 
   131)   use Realization_Subsurface_class
   132)   use Patch_module
   133)   use Option_module
   134)   use Coupler_module
   135)   use Connection_module
   136)   use Grid_module
   137)  
   138)   implicit none
   139)   
   140)   type(realization_subsurface_type) :: realization
   141) 
   142)   type(option_type), pointer :: option
   143)   type(patch_type),pointer :: patch
   144)   type(grid_type), pointer :: grid
   145)   type(coupler_type), pointer :: boundary_condition
   146) 
   147)   PetscInt :: ghosted_id, iconn, sum_connection, ipara
   148)   type(Flash2_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)  
   149)   
   150)   option => realization%option
   151)   patch => realization%patch
   152)   grid => patch%grid
   153)   !print *,' Flash2 setup get patch'
   154)   patch%aux%Flash2 => Flash2AuxCreate()
   155)   
   156) !  option%io_buffer = 'Before Flash2 can be run, the thc_parameter object ' // &
   157) !                     'must be initialized with the proper variables ' // &
   158) !                     'Flash2AuxCreate() is called anyhwere.'
   159) !  call printErrMsg(option)
   160)   !print *,' Flash2 setup get Aux', option%nphase, size(patch%saturation_function_array)
   161) ! Flash2_parameters create *********************************************
   162) ! Sir
   163)   allocate(patch%aux%Flash2%Flash2_parameter%sir(option%nphase, &
   164)                                   size(patch%saturation_function_array)))
   165)    !print *,' Flash2 setup get patch: sir, allocated'
   166)   do ipara = 1, size(patch%saturation_function_array)
   167)     patch%aux%Flash2%Flash2_parameter%sir(:,patch% &
   168)         saturation_function_array(ipara)%ptr%id) = &
   169)       patch%saturation_function_array(ipara)%ptr%Sr(:)
   170)   enddo
   171)   !print *,' Flash2 setup get patch: sir'
   172) ! dencpr  
   173)   allocate(patch%aux%Flash2%Flash2_parameter%dencpr(size(patch%material_property_array)))
   174)   do ipara = 1, size(patch%material_property_array)
   175)     patch%aux%Flash2%Flash2_parameter%dencpr(iabs(patch% &
   176)         material_property_array(ipara)%ptr%internal_id)) = &
   177)       patch%material_property_array(ipara)%ptr%rock_density*option%scale*&
   178)       patch%material_property_array(ipara)%ptr%specific_heat
   179)   enddo
   180) ! ckwet
   181)   allocate(patch%aux%Flash2%Flash2_parameter%ckwet(size(patch%material_property_array)))
   182)   do ipara = 1, size(patch%material_property_array)
   183)     patch%aux%Flash2%Flash2_parameter%ckwet(iabs(patch% &
   184)         material_property_array(ipara)%ptr%internal_id)) = &
   185)       patch%material_property_array(ipara)%ptr%thermal_conductivity_wet*option%scale
   186)   enddo
   187) ! Flash2_parameters create_end *****************************************
   188) 
   189) ! allocate auxvar data structures for all grid cells  
   190)   allocate(auxvars(grid%ngmax))
   191)   !print *,' Flash2 setup get Aux alloc', grid%ngmax
   192)   do ghosted_id = 1, grid%ngmax
   193)     call Flash2AuxVarInit(auxvars(ghosted_id),option)
   194)   enddo
   195)   patch%aux%Flash2%auxvars => auxvars
   196)   patch%aux%Flash2%num_aux = grid%ngmax
   197)   !print *,' Flash2 setup get Aux init'
   198) 
   199) !  allocate(delx(option%nflowdof, grid%ngmax))
   200) !  allocate(Resold_AR(grid%nlmax,option%nflowdof))
   201) !  allocate(Resold_FL(ConnectionGetNumberInList(patch%grid%&
   202) !           internal_connection_set_list),option%nflowdof))
   203) 
   204)   !print *,' Flash2 setup allocate app array'
   205)    ! count the number of boundary connections and allocate
   206)   ! auxvar data structures for them  
   207)   boundary_condition => patch%boundary_condition_list%first
   208)   sum_connection = 0    
   209)   do 
   210)     if (.not.associated(boundary_condition)) exit
   211)     sum_connection = sum_connection + &
   212)                      boundary_condition%connection_set%num_connections
   213)     boundary_condition => boundary_condition%next
   214)   enddo
   215)   allocate(auxvars_bc(sum_connection))
   216)   !print *,' Flash2 setup get AuxBc alloc', sum_connection
   217)   do iconn = 1, sum_connection
   218)     call Flash2AuxVarInit(auxvars_bc(iconn),option)
   219)   enddo
   220)   patch%aux%Flash2%auxvars_bc => auxvars_bc
   221)   patch%aux%Flash2%num_aux_bc = sum_connection
   222)   option%flow%numerical_derivatives = PETSC_TRUE
   223)   
   224)   allocate(patch%aux%Flash2%delx(option%nflowdof, grid%ngmax))
   225)   allocate(patch%aux%Flash2%Resold_AR(grid%nlmax,option%nflowdof))
   226)   allocate(patch%aux%Flash2%Resold_BC(grid%nlmax,option%nflowdof))
   227)   ! should be allocated by the number of BC connections, just for debug now
   228)   allocate(patch%aux%Flash2%Resold_FL(ConnectionGetNumberInList(patch%grid%&
   229)            internal_connection_set_list),option%nflowdof))
   230) 
   231) end subroutine Flash2SetupPatch
   232) 
   233) ! ************************************************************************** !
   234) 
   235) subroutine Flash2ComputeMassBalance(realization,mass_balance,mass_trapped)
   236) !
   237) ! Author: Glenn Hammond
   238) ! Date: 02/22/08
   239) !
   240) 
   241)   use Realization_Subsurface_class
   242)   use Patch_module
   243) 
   244)   type(realization_subsurface_type) :: realization
   245)   PetscReal :: mass_balance(realization%option%nflowspec,realization%option%nphase)
   246)   PetscReal :: mass_trapped(realization%option%nphase)
   247) 
   248)   type(patch_type), pointer :: cur_patch
   249) 
   250)   mass_balance = 0.d0
   251)   mass_trapped = 0.d0
   252) 
   253)   cur_patch => realization%patch_list%first
   254)   do
   255)     if (.not.associated(cur_patch)) exit
   256)     realization%patch => cur_patch
   257)     call Flash2ComputeMassBalancePatch(realization,mass_balance,mass_trapped)
   258)     cur_patch => cur_patch%next
   259)   enddo
   260) 
   261) end subroutine Flash2ComputeMassBalance
   262) 
   263) ! ************************************************************************** !
   264) 
   265) subroutine Flash2ComputeMassBalancePatch(realization,mass_balance,mass_trapped)
   266) !
   267) ! Initializes mass balance
   268) !
   269) ! Author: Glenn Hammond
   270) ! Date: 12/19/08
   271) !
   272) 
   273)   use Realization_Subsurface_class
   274)   use Option_module
   275)   use Patch_module
   276)   use Field_module
   277)   use Grid_module
   278)   use Material_Aux_class
   279) ! use Saturation_Function_module
   280) ! use Flash2_pckr_module
   281) 
   282)   implicit none
   283) 
   284)   type(realization_subsurface_type) :: realization
   285) ! type(saturation_function_type) :: saturation_function_type
   286) 
   287)   PetscReal :: mass_balance(realization%option%nflowspec,realization%option%nphase)
   288)   PetscReal :: mass_trapped(realization%option%nphase)
   289) 
   290)   type(option_type), pointer :: option
   291)   type(patch_type), pointer :: patch
   292)   type(field_type), pointer :: field
   293)   type(grid_type), pointer :: grid
   294)   type(Flash2_auxvar_type), pointer :: Flash2_auxvars(:)
   295)   class(material_auxvar_type), pointer :: material_auxvars(:)
   296)   PetscReal, pointer :: icap_loc_p(:)
   297) 
   298)   PetscErrorCode :: ierr
   299)   PetscInt :: local_id
   300)   PetscInt :: ghosted_id
   301)   PetscInt :: iphase
   302)   PetscInt :: ispec_start, ispec_end, ispec
   303)   PetscReal :: pckr_sir(realization%option%nphase)
   304) 
   305)   option => realization%option
   306)   patch => realization%patch
   307)   grid => patch%grid
   308)   field => realization%field
   309) 
   310)   Flash2_auxvars => patch%aux%Flash2%auxvars
   311)   material_auxvars => patch%aux%Material%auxvars
   312) 
   313)   call VecGetArrayF90(field%icap_loc,icap_loc_p, ierr);CHKERRQ(ierr)
   314) 
   315)   do local_id = 1, grid%nlmax
   316)     ghosted_id = grid%nL2G(local_id)
   317) 
   318) !geh - Ignore inactive cells with inactive materials
   319)     if (associated(patch%imat)) then
   320)       if (patch%imat(ghosted_id) <= 0) cycle
   321)     endif
   322) 
   323) ! mass = volume * saturation * density * mole fraction
   324)     do iphase = 1, option%nphase
   325)       do ispec = 1, option%nflowspec
   326)         mass_balance(ispec,iphase) = mass_balance(ispec,iphase) + &
   327)         Flash2_auxvars(ghosted_id)%auxvar_elem(0)%xmol(ispec+(iphase-1)*option%nflowspec)* &
   328)         Flash2_auxvars(ghosted_id)%auxvar_elem(0)%den(iphase)* &
   329)         Flash2_auxvars(ghosted_id)%auxvar_elem(0)%sat(iphase)* &
   330)         material_auxvars(ghosted_id)%porosity*material_auxvars(ghosted_id)%volume
   331)       enddo
   332) 
   333)       pckr_sir(iphase) = &
   334)       patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr%sr(iphase)
   335) 
   336)       if (iphase == 1 .and. &
   337)         Flash2_auxvars(ghosted_id)%auxvar_elem(0)%sat(iphase) <= pckr_sir(iphase)) then
   338)         ispec = 1
   339)         mass_trapped(iphase) = mass_trapped(iphase) + &
   340)         Flash2_auxvars(ghosted_id)%auxvar_elem(0)%xmol(ispec+(iphase-1)*option%nflowspec)* &
   341)         Flash2_auxvars(ghosted_id)%auxvar_elem(0)%den(iphase)* &
   342)         Flash2_auxvars(ghosted_id)%auxvar_elem(0)%sat(iphase)* &
   343)         material_auxvars(ghosted_id)%porosity*material_auxvars(ghosted_id)%volume
   344)       endif
   345) 
   346)       if (iphase == 2 .and. &
   347)         Flash2_auxvars(ghosted_id)%auxvar_elem(0)%sat(iphase) <= pckr_sir(iphase)) then
   348)         ispec = 2
   349)         mass_trapped(iphase) = mass_trapped(iphase) + &
   350)         Flash2_auxvars(ghosted_id)%auxvar_elem(0)%xmol(ispec+(iphase-1)*option%nflowspec)* &
   351)         Flash2_auxvars(ghosted_id)%auxvar_elem(0)%den(iphase)* &
   352)         Flash2_auxvars(ghosted_id)%auxvar_elem(0)%sat(iphase)* &
   353)         material_auxvars(ghosted_id)%porosity*material_auxvars(ghosted_id)%volume
   354)       endif
   355)     enddo
   356)   enddo
   357) 
   358)   call VecRestoreArrayF90(field%icap_loc,icap_loc_p, ierr);CHKERRQ(ierr)
   359) 
   360) end subroutine Flash2ComputeMassBalancePatch
   361) 
   362) ! ************************************************************************** !
   363) 
   364) subroutine FLASH2ZeroMassBalDeltaPatch(realization)
   365) !
   366) ! Zeros mass balance delta array
   367) !
   368) ! Author: Glenn Hammond
   369) ! Date: 12/19/08
   370) !
   371) 
   372)   use Realization_Subsurface_class
   373)   use Option_module
   374)   use Patch_module
   375)   use Grid_module
   376) 
   377)   implicit none
   378) 
   379)   type(realization_subsurface_type) :: realization
   380) 
   381)   type(option_type), pointer :: option
   382)   type(patch_type), pointer :: patch
   383)   type(global_auxvar_type), pointer :: global_auxvars_bc(:)
   384)   type(global_auxvar_type), pointer :: global_auxvars_ss(:)
   385) 
   386)   PetscInt :: iconn
   387) 
   388)   option => realization%option
   389)   patch => realization%patch
   390) 
   391)   global_auxvars_bc => patch%aux%Global%auxvars_bc
   392)   global_auxvars_ss => patch%aux%Global%auxvars_ss
   393) 
   394) #ifdef COMPUTE_INTERNAL_MASS_FLUX
   395)   do iconn = 1, patch%aux%FLASH2%num_aux
   396)     patch%aux%Global%auxvars(iconn)%mass_balance_delta = 0.d0
   397)   enddo
   398) #endif
   399) 
   400) ! Intel 10.1 on Chinook reports a SEGV if this conditional is not
   401) ! placed around the internal do loop - geh
   402)   if (patch%aux%Flash2%num_aux_bc > 0) then
   403)     do iconn = 1, patch%aux%FLASH2%num_aux_bc
   404)       global_auxvars_bc(iconn)%mass_balance_delta = 0.d0
   405)     enddo
   406)   endif
   407) 
   408)   if (patch%aux%FLASH2%num_aux_ss > 0) then
   409)     do iconn = 1, patch%aux%FLASH2%num_aux_ss
   410)       global_auxvars_ss(iconn)%mass_balance_delta = 0.d0
   411)     enddo
   412)   endif
   413) 
   414) end subroutine FLASH2ZeroMassBalDeltaPatch
   415) 
   416) ! ************************************************************************** !
   417) 
   418) subroutine FLASH2UpdateMassBalancePatch(realization)
   419) !
   420) ! Updates mass balance
   421) !
   422) ! Author: Glenn Hammond
   423) ! Date: 12/19/08
   424) !
   425) 
   426)   use Realization_Subsurface_class
   427)   use Option_module
   428)   use Patch_module
   429)   use Grid_module
   430) 
   431)   implicit none
   432) 
   433)   type(realization_subsurface_type) :: realization
   434) 
   435)   type(option_type), pointer :: option
   436)   type(patch_type), pointer :: patch
   437)   type(global_auxvar_type), pointer :: global_auxvars_bc(:)
   438)   type(global_auxvar_type), pointer :: global_auxvars_ss(:)
   439) 
   440)   PetscInt :: iconn
   441) 
   442)   option => realization%option
   443)   patch => realization%patch
   444) 
   445)   global_auxvars_bc => patch%aux%Global%auxvars_bc
   446)   global_auxvars_ss => patch%aux%Global%auxvars_ss
   447) 
   448) #ifdef COMPUTE_INTERNAL_MASS_FLUX
   449)   do iconn = 1, patch%aux%Flash2%num_aux
   450)     patch%aux%Global%auxvars(iconn)%mass_balance = &
   451)     patch%aux%Global%auxvars(iconn)%mass_balance + &
   452)     patch%aux%Global%auxvars(iconn)%mass_balance_delta* &
   453)     option%flow_dt
   454)   enddo
   455) #endif
   456) 
   457) ! Intel 10.1 on Chinook reports a SEGV if this conditional is not
   458) ! placed around the internal do loop - geh
   459)   if (patch%aux%FLASH2%num_aux_bc > 0) then
   460)     do iconn = 1, patch%aux%Flash2%num_aux_bc
   461)       global_auxvars_bc(iconn)%mass_balance = &
   462)       global_auxvars_bc(iconn)%mass_balance + &
   463)       global_auxvars_bc(iconn)%mass_balance_delta*option%flow_dt
   464)     enddo
   465)   endif
   466) 
   467)   if (patch%aux%FLASH2%num_aux_ss > 0) then
   468)     do iconn = 1, patch%aux%Flash2%num_aux_ss
   469)       global_auxvars_ss(iconn)%mass_balance = &
   470)       global_auxvars_ss(iconn)%mass_balance + &
   471)       global_auxvars_ss(iconn)%mass_balance_delta*option%flow_dt
   472)     enddo
   473)   endif
   474) 
   475) end subroutine FLASH2UpdateMassBalancePatch
   476) 
   477) ! ************************************************************************** !
   478) 
   479)   function  Flash2InitGuessCheck(realization)
   480)   !
   481)   ! Flash2initguesscheckpatch:
   482)   !
   483)   ! Author: Chuan Lu
   484)   ! Date: 12/10/07
   485)   !
   486) 
   487)   use Realization_Subsurface_class
   488)   use Patch_module
   489)   use Option_module
   490) 
   491)   PetscInt ::  Flash2InitGuessCheck
   492)   type(realization_subsurface_type) :: realization
   493)   type(option_type), pointer :: option
   494)   type(patch_type), pointer :: cur_patch
   495)   PetscInt :: ipass, ipass0
   496)   PetscErrorCode :: ierr
   497) 
   498)   option => realization%option
   499)   ipass = 1
   500)   cur_patch => realization%patch_list%first
   501)   do
   502)     if (.not.associated(cur_patch)) exit
   503)     realization%patch => cur_patch
   504)     ipass= Flash2InitGuessCheckPatch(realization)
   505)     if (ipass<=0)then
   506)       exit 
   507)     endif
   508)     cur_patch => cur_patch%next
   509)   enddo
   510) 
   511)    call MPI_Barrier(option%mycomm,ierr)
   512)    if (option%mycommsize >1)then
   513)       call MPI_Allreduce(ipass,ipass0,ONE_INTEGER_MPI,MPIU_INTEGER,MPI_SUM, &
   514)                          option%mycomm,ierr)
   515)       if (ipass0 < option%mycommsize) ipass=-1
   516)    endif
   517)    Flash2InitGuessCheck =ipass
   518)  end function Flash2InitGuessCheck
   519) 
   520) ! ************************************************************************** !
   521) 
   522) subroutine Flash2UpdateReasonPatch(reason,realization)
   523)   ! 
   524)   ! Flash2initguesscheckpatch:
   525)   ! 
   526)   ! Author: Chuan Lu
   527)   ! Date: 10/10/08
   528)   ! 
   529) 
   530)    use Realization_Subsurface_class
   531)    use Patch_module
   532)    use Field_module
   533)    use Option_module
   534)    use Grid_module
   535) 
   536)   implicit none
   537) 
   538) 
   539)   PetscInt, intent(out) :: reason
   540)   type(realization_subsurface_type) :: realization  
   541)   type(patch_type),pointer :: patch
   542)   type(grid_type), pointer :: grid
   543)   type(field_type), pointer :: field
   544)   type(option_type), pointer :: option 
   545)   PetscReal, pointer :: xx_p(:), yy_p(:) 
   546)   PetscInt :: n,n0,re
   547)   PetscInt :: re0, iipha
   548)   PetscErrorCode :: ierr
   549)   
   550)   option => realization%option
   551)   field => realization%field  
   552)   patch => realization%patch
   553)   grid => patch%grid
   554) 
   555)   re=1
   556)  
   557)   if (re > 0) then
   558)     call VecGetArrayReadF90(field%flow_xx, xx_p, ierr);CHKERRQ(ierr)
   559)     call VecGetArrayF90(field%flow_yy, yy_p, ierr);CHKERRQ(ierr)
   560) 
   561)     do n = 1,grid%nlmax
   562) !**** clu-Ignore inactive cells with inactive materials **************
   563)       if (associated(patch%imat)) then
   564)         if (patch%imat(grid%nL2G(n)) <= 0) cycle
   565)       endif
   566)       n0=(n-1)* option%nflowdof
   567)   
   568) ! ******** Too huge change in pressure ****************     
   569) !geh: I don't believe that this code is being used.  Therefore, I will add an
   570) !     error message and let someone sort the use of option%dpmxe later
   571)         option%io_buffer = 'option%dpmxe and option%dtmpmxe needs to be ' // &
   572)           'refactored in Flash2UpdateReasonPatch'
   573)         call printErrMsg(option)
   574) !geh      if (dabs(xx_p(n0 + 1) - yy_p(n0 + 1)) > (10.0D0 * option%dpmxe)) then
   575)         re=0; print *,'huge change in p', xx_p(n0 + 1), yy_p(n0 + 1)
   576)         exit
   577) !geh      endif
   578) 
   579) ! ******** Too huge change in temperature ****************
   580) !geh      if (dabs(xx_p(n0 + 2) - yy_p(n0 + 2)) > (10.0D0 * option%dtmpmxe)) then
   581)         re=0; print *,'huge change in T', xx_p(n0 + 2), yy_p(n0 + 2)
   582)         exit
   583) !geh      endif
   584)  
   585) ! ******* Check 0<=total mass fraction <=1 **************************
   586)       if (xx_p(n0 + 3) > 1.D0) then
   587)         re=0; exit
   588)         endif
   589)         if (xx_p(n0 + 3) < 0.d0) then
   590)           re=0; exit
   591)         endif
   592)      enddo
   593)   
   594)     !if (re<=0) print *,'Sat out of Region at: ',n,iipha,xx_p(n0+1:n0+3)
   595)     call VecRestoreArrayReadF90(field%flow_xx, xx_p, ierr);CHKERRQ(ierr)
   596)     call VecRestoreArrayF90(field%flow_yy, yy_p, ierr);CHKERRQ(ierr)
   597) 
   598)    endif
   599)   ! reason = re!; print *,'reason:',reason
   600) end subroutine Flash2UpdateReasonPatch
   601) 
   602) ! ************************************************************************** !
   603) 
   604) subroutine Flash2UpdateReason(reason, realization)
   605)   ! 
   606)   ! Flash2UpdateAuxVars: Updates the auxiliary variables associated with
   607)   ! the Richards problem
   608)   ! 
   609)   ! Author: Chuan Lu
   610)   ! Date: 10/10/08
   611)   ! 
   612) 
   613)   use Realization_Subsurface_class
   614)   use Patch_module
   615)   implicit none
   616) 
   617)   type(realization_subsurface_type) :: realization
   618)   
   619)   type(patch_type), pointer :: cur_patch
   620)   PetscInt :: reason
   621) 
   622)   PetscInt :: re, re0
   623)   PetscErrorCode :: ierr
   624) 
   625)   re = 1
   626)   cur_patch => realization%patch_list%first
   627)   do
   628)     if (.not.associated(cur_patch)) exit
   629)     realization%patch => cur_patch
   630)     call Flash2UpdateReasonPatch(re, realization)
   631)     if (re<=0) then
   632)       exit 
   633)     endif
   634)     cur_patch => cur_patch%next
   635)   enddo
   636) 
   637)   call MPI_Barrier(realization%option%mycomm,ierr)
   638) !  print *, 'flash reason ', re
   639)   if (realization%option%mycommsize >1)then
   640)      call MPI_Allreduce(re,re0,ONE_INTEGER_MPI,MPIU_INTEGER,MPI_SUM, &
   641)                         realization%option%mycomm,ierr)
   642)      if (re0<realization%option%mycommsize) re=0
   643)   endif
   644)   reason=re
   645)   
   646)   if (reason<=0 .and. realization%option%myrank ==0) print *,'Sat or Con out of Region', re
   647) end subroutine Flash2UpdateReason
   648) 
   649) ! ************************************************************************** !
   650) 
   651)   function  Flash2InitGuessCheckPatch(realization)
   652)   ! 
   653)   ! Author: Chuan Lu
   654)   ! Date: 10/10/08
   655)   ! 
   656)    
   657)     use co2_span_wagner_module
   658)      
   659)     use Realization_Subsurface_class
   660)     use Patch_module
   661)     use Field_module
   662)     use Grid_module
   663)     use Option_module
   664)     implicit none
   665)     
   666)     PetscInt :: Flash2InitGuessCheckPatch 
   667)     type(realization_subsurface_type) :: realization
   668)     type(grid_type), pointer :: grid
   669)     type(patch_type), pointer :: patch
   670)     type(option_type), pointer :: option
   671)     type(field_type), pointer :: field
   672)       
   673)     PetscInt :: local_id, ghosted_id, ipass
   674)     PetscErrorCode :: ierr
   675)     PetscReal, pointer :: xx_p(:)
   676) 
   677) 
   678)     patch => realization%patch
   679)     grid => patch%grid
   680)     option => realization%option
   681)     field => realization%field
   682)     
   683)     call VecGetArrayReadF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
   684)     
   685)     ipass=1
   686)     do local_id = 1, grid%nlmax
   687)       ghosted_id = grid%nL2G(local_id)
   688)       !geh - Ignore inactive cells with inactive materials
   689)       if (associated(patch%imat)) then
   690)         if (patch%imat(ghosted_id) <= 0) cycle
   691)       endif
   692)       
   693) !   insure zero liquid sat not passed to ptran (no effect on pflow)
   694)       if (xx_p((local_id-1)*option%nflowdof+3) < 0.D0) &
   695)         xx_p((local_id-1)*option%nflowdof+3) = zerocut
   696)       if (xx_p((local_id-1)*option%nflowdof+3) > 1.D0) &
   697)         xx_p((local_id-1)*option%nflowdof+3) = 1.D0 - zerocut
   698)     
   699) !   check if p,T within range of table  
   700)       if (xx_p((local_id-1)*option%nflowdof+1) < p0_tab*1D6 &
   701)         .or. xx_p((local_id-1)*option%nflowdof+1) > &
   702)         (ntab_p*dp_tab + p0_tab)*1D6) then
   703)         ipass=-1; exit
   704)       endif
   705)       if (xx_p((local_id-1)*option%nflowdof+2) < t0_tab -273.15D0 &
   706)         .or. xx_p((local_id-1)*option%nflowdof+2) > &
   707)         ntab_t*dt_tab + t0_tab-273.15D0) then
   708)         ipass=-1; exit
   709)       endif
   710)     enddo
   711) 
   712)     call VecRestoreArrayReadF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
   713)     Flash2InitGuessCheckPatch = ipass
   714)   end function Flash2InitGuessCheckPatch
   715) 
   716) ! ************************************************************************** !
   717) 
   718) subroutine Flash2UpdateAuxVars(realization)
   719)   ! 
   720)   ! Updates the auxiliary variables associated with
   721)   ! the Flash2 problem
   722)   ! 
   723)   ! Author: Chuan Lu
   724)   ! Date: 10/10/08
   725)   ! 
   726) 
   727)   use Realization_Subsurface_class
   728)   use Patch_module
   729) 
   730)   type(realization_subsurface_type) :: realization
   731)   
   732)   type(patch_type), pointer :: cur_patch
   733)   
   734)   cur_patch => realization%patch_list%first
   735)   do
   736)     if (.not.associated(cur_patch)) exit
   737)     realization%patch => cur_patch
   738)     call Flash2UpdateAuxVarsPatch(realization)
   739)     cur_patch => cur_patch%next
   740)   enddo
   741) 
   742) end subroutine Flash2UpdateAuxVars
   743) 
   744) ! ************************************************************************** !
   745) 
   746) subroutine Flash2UpdateAuxVarsPatch(realization)
   747)   ! 
   748)   ! Updates the auxiliary variables associated with
   749)   ! the Flash2 problem
   750)   ! 
   751)   ! Author: Chuan Lu
   752)   ! Date: 12/10/07
   753)   ! 
   754) 
   755)   use Realization_Subsurface_class
   756)   use Patch_module
   757)   use Field_module
   758)   use Option_module
   759)   use Grid_module
   760)   use Coupler_module
   761)   use Connection_module
   762)   use Material_module
   763)   
   764)   implicit none
   765) 
   766)   type(realization_subsurface_type) :: realization
   767)   
   768)   type(option_type), pointer :: option
   769)   type(patch_type), pointer :: patch
   770)   type(grid_type), pointer :: grid
   771)   type(field_type), pointer :: field
   772)   type(coupler_type), pointer :: boundary_condition
   773)   type(connection_set_type), pointer :: cur_connection_set
   774)   type(Flash2_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
   775)   type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
   776) 
   777)   PetscInt :: ghosted_id, local_id, istart, iend, sum_connection, idof, iconn
   778)   PetscInt :: iphasebc, iphase
   779)   PetscReal, pointer :: xx_loc_p(:), icap_loc_p(:), iphase_loc_p(:)
   780)   PetscReal :: xxbc(realization%option%nflowdof)
   781)   PetscReal :: mnacl, ynacl, xphi
   782)   PetscErrorCode :: ierr
   783)   
   784)   option => realization%option
   785)   patch => realization%patch
   786)   grid => patch%grid
   787)   field => realization%field
   788)   
   789)   auxvars => patch%aux%Flash2%auxvars
   790)   auxvars_bc => patch%aux%Flash2%auxvars_bc
   791)   global_auxvars => patch%aux%Global%auxvars
   792)   global_auxvars_bc => patch%aux%Global%auxvars_bc
   793) 
   794)   
   795)   call VecGetArrayF90(field%flow_xx_loc,xx_loc_p, ierr);CHKERRQ(ierr)
   796)   call VecGetArrayF90(field%icap_loc,icap_loc_p,ierr);CHKERRQ(ierr)
   797) 
   798)   do ghosted_id = 1, grid%ngmax
   799)     if (grid%nG2L(ghosted_id) < 0) cycle ! bypass ghosted corner cells
   800)     !geh - Ignore inactive cells with inactive materials
   801)     if (associated(patch%imat)) then
   802)       if (patch%imat(ghosted_id) <= 0) cycle
   803)     endif
   804)     iend = ghosted_id*option%nflowdof
   805)     istart = iend-option%nflowdof+1
   806)     if (.not. associated(patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr))then
   807)        print*, 'error!!! saturation function not allocated', ghosted_id,icap_loc_p(ghosted_id)
   808)     endif
   809)     
   810)     call Flash2AuxVarCompute_NINC(xx_loc_p(istart:iend), &
   811)                        auxvars(ghosted_id)%auxvar_elem(0), &
   812)                        global_auxvars(ghosted_id), &
   813)                        patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr, &
   814)                        realization%fluid_properties,option)
   815)                       
   816)  ! update global variables
   817)     if ( associated(global_auxvars))then
   818)     
   819)       global_auxvars(ghosted_id)%pres(:) = auxvars(ghosted_id)%auxvar_elem(0)%pres -&
   820)                auxvars(ghosted_id)%auxvar_elem(0)%pc(:)
   821)       global_auxvars(ghosted_id)%temp = auxvars(ghosted_id)%auxvar_elem(0)%temp
   822)       global_auxvars(ghosted_id)%sat(:)=auxvars(ghosted_id)%auxvar_elem(0)%sat(:)
   823) !     global_auxvars(ghosted_id)%fugacoeff(1) = xphi
   824)       global_auxvars(ghosted_id)%den(:) = auxvars(ghosted_id)%auxvar_elem(0)%den(:)
   825)       global_auxvars(ghosted_id)%den_kg(:) = auxvars(ghosted_id)%auxvar_elem(0)%den(:) &
   826)                                           * auxvars(ghosted_id)%auxvar_elem(0)%avgmw(:)
   827)       mnacl= global_auxvars(ghosted_id)%m_nacl(1)
   828)       if (global_auxvars(ghosted_id)%m_nacl(2) > mnacl) mnacl = global_auxvars(ghosted_id)%m_nacl(2)
   829)       ynacl = mnacl/(1.d3/FMWH2O + mnacl)
   830)       global_auxvars(ghosted_id)%xmass(1) = (1.d0-ynacl)&
   831)                               *auxvars(ghosted_id)%auxvar_elem(0)%xmol(1) * FMWH2O&
   832)                               /((1.d0-ynacl)*auxvars(ghosted_id)%auxvar_elem(0)%xmol(1) * FMWH2O &
   833)                               +auxvars(ghosted_id)%auxvar_elem(0)%xmol(2) * FMWCO2 &
   834)                               +ynacl*auxvars(ghosted_id)%auxvar_elem(0)%xmol(1)*FMWNACL)
   835)       global_auxvars(ghosted_id)%xmass(2)=auxvars(ghosted_id)%auxvar_elem(0)%xmol(3) * FMWH2O&
   836)                               /(auxvars(ghosted_id)%auxvar_elem(0)%xmol(3) * FMWH2O&
   837)                               +auxvars(ghosted_id)%auxvar_elem(0)%xmol(4) * FMWCO2) 
   838)       global_auxvars(ghosted_id)%reaction_rate_store(:) = global_auxvars(ghosted_id)%reaction_rate(:)
   839)       global_auxvars(ghosted_id)%reaction_rate(:) = 0.D0
   840)     else
   841)       print *,'Not associated global for FLASH2'
   842)     endif
   843) 
   844) 
   845)   enddo
   846) ! print *,'Flash2UpdateAuxVarsPatch: end internal'
   847)   boundary_condition => patch%boundary_condition_list%first
   848)   sum_connection = 0    
   849)   do 
   850)     if (.not.associated(boundary_condition)) exit
   851)     cur_connection_set => boundary_condition%connection_set
   852)     do iconn = 1, cur_connection_set%num_connections
   853)       sum_connection = sum_connection + 1
   854)       local_id = cur_connection_set%id_dn(iconn)
   855)       ghosted_id = grid%nL2G(local_id)
   856)       if (associated(patch%imat)) then
   857)         if (patch%imat(ghosted_id) <= 0) cycle
   858)       endif
   859)       do idof=1,option%nflowdof
   860)         select case(boundary_condition%flow_condition%itype(idof))
   861)         case(DIRICHLET_BC)
   862)           xxbc(:) = boundary_condition%flow_aux_real_var(:,iconn)
   863)         case(HYDROSTATIC_BC)
   864)           xxbc(1) = boundary_condition%flow_aux_real_var(1,iconn)
   865)           xxbc(2:option%nflowdof) = &
   866)                xx_loc_p((ghosted_id-1)*option%nflowdof+2:ghosted_id*option%nflowdof)
   867)         case(NEUMANN_BC,ZERO_GRADIENT_BC)
   868)           xxbc(:) = xx_loc_p((ghosted_id-1)*option%nflowdof+1:ghosted_id*option%nflowdof)
   869)         end select
   870)       enddo
   871)  
   872)       call Flash2AuxVarCompute_NINC(xxbc,auxvars_bc(sum_connection)%auxvar_elem(0), &
   873)                          global_auxvars_bc(sum_connection), &
   874)                          patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr, &
   875)                          realization%fluid_properties, option, xphi)
   876) 
   877)       if (associated(global_auxvars_bc)) then
   878)         global_auxvars_bc(sum_connection)%pres(:)= auxvars_bc(sum_connection)%auxvar_elem(0)%pres -&
   879)                      auxvars(ghosted_id)%auxvar_elem(0)%pc(:)
   880)         global_auxvars_bc(sum_connection)%temp=auxvars_bc(sum_connection)%auxvar_elem(0)%temp
   881)         global_auxvars_bc(sum_connection)%sat(:)=auxvars_bc(sum_connection)%auxvar_elem(0)%sat(:)
   882)         !    global_auxvars(ghosted_id)%sat_store = 
   883)         global_auxvars_bc(sum_connection)%fugacoeff(1)=xphi
   884)         global_auxvars_bc(sum_connection)%den(:)=auxvars_bc(sum_connection)%auxvar_elem(0)%den(:)
   885)         global_auxvars_bc(sum_connection)%den_kg = auxvars_bc(sum_connection)%auxvar_elem(0)%den(:) &
   886)                               * auxvars_bc(sum_connection)%auxvar_elem(0)%avgmw(:)
   887)         mnacl= global_auxvars_bc(sum_connection)%m_nacl(1)
   888)         if (global_auxvars_bc(sum_connection)%m_nacl(2)>mnacl) mnacl= global_auxvars_bc(sum_connection)%m_nacl(2)
   889)         ynacl = mnacl/(1.d3/FMWH2O + mnacl)
   890)         global_auxvars_bc(sum_connection)%xmass(1) = (1.d0-ynacl)&
   891)                               *auxvars_bc(sum_connection)%auxvar_elem(0)%xmol(1) * FMWH2O&
   892)                               /((1.d0-ynacl)*auxvars_bc(sum_connection)%auxvar_elem(0)%xmol(1) * FMWH2O &
   893)                               +auxvars_bc(sum_connection)%auxvar_elem(0)%xmol(2) * FMWCO2 &
   894)                               +ynacl*auxvars_bc(sum_connection)%auxvar_elem(0)%xmol(1)*FMWNACL)
   895)         global_auxvars_bc(sum_connection)%xmass(2) = auxvars_bc(sum_connection)%auxvar_elem(0)%xmol(3) * FMWH2O&
   896)                               /(auxvars_bc(sum_connection)%auxvar_elem(0)%xmol(3) * FMWH2O&
   897)                               +auxvars_bc(sum_connection)%auxvar_elem(0)%xmol(4) * FMWCO2) 
   898)  
   899) 
   900)   !    global_auxvars(ghosted_id)%den_kg_store
   901)       endif
   902)     enddo
   903)     boundary_condition => boundary_condition%next
   904)   enddo
   905) 
   906)   call VecRestoreArrayF90(field%flow_xx_loc,xx_loc_p, ierr);CHKERRQ(ierr)
   907)   call VecRestoreArrayF90(field%icap_loc,icap_loc_p,ierr);CHKERRQ(ierr)
   908)   
   909)   patch%aux%Flash2%auxvars_up_to_date = PETSC_TRUE
   910) 
   911) end subroutine Flash2UpdateAuxVarsPatch
   912) 
   913) ! ************************************************************************** !
   914) 
   915) subroutine Flash2InitializeTimestep(realization)
   916)   ! 
   917)   ! Update data in module prior to time step
   918)   ! 
   919)   ! Author: Chuan Lu
   920)   ! Date: 10/12/08
   921)   ! 
   922) 
   923)   use Realization_Subsurface_class
   924)   
   925)   implicit none
   926)   
   927)   type(realization_subsurface_type) :: realization
   928) 
   929)   call Flash2UpdateFixedAccumulation(realization)
   930) 
   931) end subroutine Flash2InitializeTimestep
   932) 
   933) ! ************************************************************************** !
   934) 
   935) subroutine Flash2UpdateSolution(realization)
   936)   ! 
   937)   ! Updates data in module after a successful time step
   938)   ! 
   939)   ! Author: Chuan Lu
   940)   ! Date: 10/13/08
   941)   ! 
   942) 
   943)   use Realization_Subsurface_class
   944)   
   945)   implicit none
   946)   
   947)   type(realization_subsurface_type) :: realization
   948) 
   949)   PetscErrorCode :: ierr
   950)   
   951) ! make room for hysteric s-Pc-kr
   952) 
   953)   if (realization%option%compute_mass_balance_new) then
   954)     call Flash2UpdateMassBalancePatch(realization)
   955)   endif
   956) 
   957) end subroutine Flash2UpdateSolution
   958) 
   959) ! ************************************************************************** !
   960) 
   961) subroutine Flash2UpdateFixedAccumulation(realization)
   962)   ! 
   963)   ! Updates the fixed portion of the
   964)   ! accumulation term
   965)   ! 
   966)   ! Author: Chuan Lu
   967)   ! Date: 10/12/08
   968)   ! 
   969) 
   970)   use Realization_Subsurface_class
   971)   use Patch_module
   972) 
   973)   type(realization_subsurface_type) :: realization
   974)   
   975)   type(patch_type), pointer :: cur_patch
   976)   
   977)   cur_patch => realization%patch_list%first
   978)   do
   979)     if (.not.associated(cur_patch)) exit
   980)     realization%patch => cur_patch
   981)     call Flash2UpdateFixedAccumPatch(realization)
   982)     cur_patch => cur_patch%next
   983)   enddo
   984) 
   985) end subroutine Flash2UpdateFixedAccumulation
   986) 
   987) ! ************************************************************************** !
   988) 
   989) subroutine Flash2UpdateFixedAccumPatch(realization)
   990)   ! 
   991)   ! Updates the fixed portion of the
   992)   ! accumulation term
   993)   ! 
   994)   ! Author: Chuan Lu
   995)   ! Date: 10/12/08
   996)   ! 
   997) 
   998)   use Realization_Subsurface_class
   999)   use Patch_module
  1000)   use Option_module
  1001)   use Field_module
  1002)   use Grid_module
  1003)   use Material_Aux_class
  1004)   
  1005)   implicit none
  1006)   
  1007)   type(realization_subsurface_type) :: realization
  1008)   
  1009)   type(option_type), pointer :: option
  1010)   type(patch_type), pointer :: patch
  1011)   type(grid_type), pointer :: grid
  1012)   type(field_type), pointer :: field
  1013)   type(Flash2_parameter_type), pointer :: Flash2_parameter
  1014)   type(Flash2_auxvar_type), pointer :: auxvars(:)
  1015)   type(global_auxvar_type), pointer :: global_auxvars(:)
  1016)   class(material_auxvar_type), pointer :: material_auxvars(:)
  1017)   
  1018)   PetscInt :: ghosted_id, local_id, istart, iend, iphase
  1019)   PetscReal, pointer :: xx_p(:), icap_loc_p(:), iphase_loc_p(:)
  1020)   PetscReal, pointer :: ithrm_loc_p(:), accum_p(:)
  1021)                           
  1022)   PetscErrorCode :: ierr
  1023)   
  1024)   call Flash2UpdateAuxVarsPatch(realization) 
  1025)   option => realization%option
  1026)   field => realization%field
  1027)   patch => realization%patch
  1028)   grid => patch%grid
  1029) 
  1030)   global_auxvars => patch%aux%Global%auxvars
  1031)   Flash2_parameter => patch%aux%Flash2%Flash2_parameter
  1032)   auxvars => patch%aux%Flash2%auxvars
  1033)   material_auxvars => patch%aux%Material%auxvars
  1034)     
  1035)   call VecGetArrayReadF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
  1036)   call VecGetArrayF90(field%icap_loc,icap_loc_p,ierr);CHKERRQ(ierr)
  1037)   call VecGetArrayF90(field%ithrm_loc,ithrm_loc_p,ierr);CHKERRQ(ierr)
  1038) 
  1039)   call VecGetArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
  1040) 
  1041)   do local_id = 1, grid%nlmax
  1042)     ghosted_id = grid%nL2G(local_id)
  1043)     !geh - Ignore inactive cells with inactive materials
  1044)     if (associated(patch%imat)) then
  1045)       if (patch%imat(ghosted_id) <= 0) cycle
  1046)     endif
  1047)     iend = local_id*option%nflowdof
  1048)     istart = iend-option%nflowdof+1
  1049) 
  1050)     call Flash2Accumulation(auxvars(ghosted_id)%auxvar_elem(0), &
  1051)                               global_auxvars(ghosted_id), &
  1052)                               material_auxvars(ghosted_id)%porosity, &
  1053)                               material_auxvars(ghosted_id)%volume, &
  1054)                               Flash2_parameter%dencpr(int(ithrm_loc_p(ghosted_id))), &
  1055)                               option,ZERO_INTEGER, accum_p(istart:iend)) 
  1056)   enddo
  1057) 
  1058)   call VecRestoreArrayReadF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
  1059)   call VecRestoreArrayF90(field%icap_loc,icap_loc_p,ierr);CHKERRQ(ierr)
  1060)   call VecRestoreArrayF90(field%ithrm_loc,ithrm_loc_p,ierr);CHKERRQ(ierr)
  1061) 
  1062)   call VecRestoreArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
  1063) 
  1064) #if 0
  1065) !  call Flash2NumericalJacobianTest(field%flow_xx,realization)
  1066) #endif
  1067) 
  1068) end subroutine Flash2UpdateFixedAccumPatch
  1069) 
  1070) ! ************************************************************************** !
  1071) 
  1072) subroutine Flash2Accumulation(auxvar,global_auxvar,por,vol,rock_dencpr,option,iireac,Res)
  1073)   ! 
  1074)   ! Computes the non-fixed portion of the accumulation
  1075)   ! term for the residual
  1076)   ! 
  1077)   ! Author: Chuan Lu
  1078)   ! Date: 10/12/08
  1079)   ! 
  1080) 
  1081)   use Option_module
  1082)   
  1083)   implicit none
  1084) 
  1085)   type(Flash2_auxvar_elem_type) :: auxvar
  1086)   type(option_type) :: option
  1087)   type(global_auxvar_type) :: global_auxvar
  1088)   PetscReal Res(1:option%nflowdof) 
  1089)   PetscReal vol,por,rock_dencpr
  1090)      
  1091)   PetscInt :: ispec, np, iireac
  1092)   PetscReal :: porXvol, mol(option%nflowspec), eng
  1093)   
  1094)  ! if (present(ireac)) iireac=ireac
  1095) 
  1096)   porXvol = por*vol
  1097)   mol=0.d0; eng=0.d0
  1098)   do np = 1, option%nphase
  1099)     do ispec = 1, option%nflowspec  
  1100)       mol(ispec) = mol(ispec) + auxvar%sat(np) * &
  1101)         auxvar%den(np) * &
  1102)         auxvar%xmol(ispec + (np-1)*option%nflowspec)
  1103)     enddo
  1104) ! if (option%use_isothermal == PETSC_FALSE) &
  1105)     eng = eng + auxvar%sat(np) * auxvar%den(np) * auxvar%u(np)
  1106)   enddo
  1107)   mol = mol * porXvol
  1108)  ! if (option%use_isothermal == PETSC_FALSE) &
  1109)   eng = eng * porXvol + (1.d0 - por)* vol * rock_dencpr * auxvar%temp 
  1110)  
  1111) ! Reaction terms here
  1112) ! Note if iireac > 0, then it is the node global index
  1113)   if (option%ntrandof > 0) then
  1114)     if (iireac > 0) then
  1115) !     H2O
  1116)       mol(1) = mol(1) + vol * global_auxvar%reaction_rate_store(1) &
  1117)         *option%flow_dt*1.D-3
  1118) !     CO2
  1119)       mol(2) = mol(2) + vol * global_auxvar%reaction_rate_store(2) &
  1120)         *option%flow_dt*1.D-3
  1121)     endif
  1122)   endif
  1123) ! if (option%use_isothermal) then
  1124) !   Res(1:option%nflowdof) = mol(:)
  1125) ! else
  1126)     Res(1:option%nflowdof-1) = mol(:)
  1127)     Res(option%nflowdof) = eng
  1128) ! endif
  1129) end subroutine Flash2Accumulation
  1130) 
  1131) ! ************************************************************************** !
  1132) 
  1133) subroutine Flash2SourceSink(mmsrc,nsrcpara,psrc,tsrc,hsrc,csrc,auxvar,isrctype,Res,&
  1134)                             qsrc_phase,energy_flag, option)
  1135)   ! 
  1136)   ! Flash2Accumulation: Computes the non-fixed portion of the accumulation
  1137)   ! term for the residual
  1138)   ! 
  1139)   ! Author: Chuan Lu
  1140)   ! Date: 10/12/08
  1141)   ! 
  1142) 
  1143)   use Option_module
  1144)   
  1145)   use EOS_Water_module
  1146) !   use Gas_EOS_module  
  1147)   use co2eos_module
  1148)   use co2_span_wagner_spline_module, only: sw_prop
  1149)   use co2_sw_module, only: co2_sw_interp
  1150)   use co2_span_wagner_module 
  1151)   
  1152)   implicit none
  1153) 
  1154)   type(Flash2_auxvar_elem_type) :: auxvar
  1155)   type(option_type) :: option
  1156)   PetscReal Res(1:option%nflowdof) 
  1157)   PetscReal, pointer :: mmsrc(:)
  1158)   PetscReal psrc(option%nphase),tsrc,hsrc, csrc 
  1159)   PetscInt isrctype, nsrcpara
  1160)   PetscBool :: energy_flag
  1161)   PetscReal :: qsrc_phase(:) 
  1162)      
  1163)   PetscReal, pointer :: msrc(:)
  1164)   PetscReal dw_kg, dw_mol,dddt,dddp
  1165)   PetscReal :: enth_src_h2o, enth_src_co2 
  1166)   PetscReal :: rho, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt, dvdp, xphi
  1167)   PetscReal :: ukvr, v_darcy, dq, dphi
  1168)   PetscReal :: well_status, well_diameter
  1169)   PetscReal :: pressure_bh, well_factor, pressure_max, pressure_min
  1170)   PetscReal :: well_inj_water, well_inj_co2
  1171)   PetscInt :: np
  1172)   PetscInt :: iflag
  1173)   PetscErrorCode :: ierr
  1174)   
  1175)   Res=0D0
  1176)   allocate(msrc(nsrcpara))
  1177)   msrc = mmsrc(1:nsrcpara)
  1178)   qsrc_phase = 0.d0
  1179)  ! if (present(ireac)) iireac=ireac
  1180) !  if (energy_flag) then
  1181) !    Res(option%nflowdof) = Res(option%nflowdof) + hsrc * option%flow_dt   
  1182) !  endif         
  1183)  
  1184)   select case(isrctype)
  1185)     case(MASS_RATE_SS)
  1186)       msrc(1) =  msrc(1) / FMWH2O
  1187)       msrc(2) =  msrc(2) / FMWCO2
  1188)       if (msrc(1) /= 0.d0) then ! H2O injection
  1189)         call EOSWaterDensity(tsrc,auxvar%pres,dw_kg,dw_mol,ierr) 
  1190)         call EOSWaterEnthalpy(tsrc,auxvar%pres,enth_src_h2o,ierr) 
  1191)         enth_src_h2o = enth_src_h2o*option%scale ! J/kmol -> whatever units
  1192) 
  1193) !           units: dw_mol [mol/dm^3]; dw_kg [kg/m^3]
  1194) !           qqsrc = qsrc1/dw_mol ! [kmol/s (mol/dm^3 = kmol/m^3)]
  1195)         Res(jh2o) = Res(jh2o) + msrc(1)*(1.d0-csrc)*option%flow_dt
  1196)         Res(jco2) = Res(jco2) + msrc(1)*csrc*option%flow_dt
  1197)         if (energy_flag) &
  1198)           Res(option%nflowdof) = Res(option%nflowdof) + msrc(1)*enth_src_h2o*option%flow_dt
  1199)         qsrc_phase(1) = msrc(1)/dw_mol
  1200)         
  1201)       endif  
  1202)     
  1203)       if (msrc(2) > 0.d0) then ! CO2 injection
  1204) !        call printErrMsg(option,"concentration source not yet implemented in Flash2")
  1205)         if (option%co2eos == EOS_SPAN_WAGNER) then
  1206)          !  span-wagner
  1207)           rho = auxvar%den(jco2)*FMWCO2  
  1208)           select case(option%itable)  
  1209)             case(0,1,2,4,5)
  1210)               if (option%itable >= 4) then
  1211)                 call co2_sw_interp(auxvar%pres*1.D-6,&
  1212)                   tsrc,rho,dddt,dddp,fg,dfgdp,dfgdt, &
  1213)                   eng,enth_src_co2,dhdt,dhdp,visc,dvdt,dvdp,option%itable)
  1214)               else
  1215)                 iflag = 1
  1216)               call co2_span_wagner(auxvar%pres*1.D-6,&
  1217)                   tsrc+273.15D0,rho,dddt,dddp,fg,dfgdp,dfgdt, &
  1218)                   eng,enth_src_co2,dhdt,dhdp,visc,dvdt,dvdp,iflag,option%itable)
  1219)               endif 
  1220)             case(3) 
  1221)               call sw_prop(tsrc,auxvar%pres*1.D-6,rho, &
  1222)                      enth_src_co2, eng, fg)
  1223)           end select     
  1224) 
  1225)          !  units: rho [kg/m^3]; csrc1 [kmol/s]
  1226)           enth_src_co2 = enth_src_co2 * FMWCO2
  1227)           qsrc_phase(2) = msrc(2)/auxvar%den(jco2)
  1228)             
  1229)         else if (option%co2eos == EOS_MRK)then
  1230) ! MRK eos [modified version from  Kerrick and Jacobs (1981) and Weir et al. (1996).]
  1231)             call CO2(tsrc,auxvar%pres, rho,fg, xphi,enth_src_co2)
  1232)             enth_src_co2 = enth_src_co2*FMWCO2*option%scale
  1233)             qsrc_phase(2) = msrc(2)/auxvar%den(jco2)
  1234)         else
  1235)           call printErrMsg(option,'pflow Flash2 ERROR: Need specify CO2 EOS')
  1236)         endif
  1237)   
  1238)         Res(jco2) = Res(jco2) + msrc(2)*option%flow_dt
  1239)         if (energy_flag) &
  1240)          Res(option%nflowdof) = Res(option%nflowdof)+ msrc(2) * enth_src_co2 *option%flow_dt
  1241)       endif
  1242) !  End of mass rate inplementation
  1243)     case(WELL_SS) ! production well
  1244)      !if node pessure is lower than the given extraction pressure, shut it down
  1245)     ! Flow term
  1246) !  well parameter explaination
  1247) !   1. well status. 1 injection; -1 production; 0 shut in
  1248) !                   2 rate controled injection (same as rate_ss, with max pressure control, not completed yet) 
  1249) !                  -2 rate controled production(not implemented for now) 
  1250) !
  1251) !   2. well factor [m^3],  the effective permeability [m^2/s]
  1252) !   3. bottomhole pressure:  [Pa]
  1253) !   4. max pressure: [Pa]
  1254) !   5. min pressure: [Pa]   
  1255) !   6. preferred mass flux of water [kg/s]
  1256) !   7. preferred mass flux of CO2 [kg/s]
  1257) !   8. well diameter, not used now
  1258) !   9. skin factor, not used now
  1259) 
  1260)       well_status = msrc(1)
  1261)       well_factor = msrc(2)
  1262)       pressure_bh = msrc(3)
  1263)       pressure_max = msrc(4)
  1264)       pressure_min = msrc(5)
  1265)       well_inj_water = msrc(6)
  1266)       well_inj_co2 = msrc(7)
  1267)     
  1268) !     if (pressure_min < 0D0) pressure_min = 0D0 !not limited by pressure lower bound   
  1269) 
  1270)     ! production well (well status = -1)
  1271)       if (dabs(well_status + 1D0) < 1D-1) then
  1272)         if (auxvar%pres > pressure_min) then
  1273)           Dq = well_factor 
  1274)           do np = 1, option%nphase
  1275)             dphi = auxvar%pres - auxvar%pc(np) - pressure_bh
  1276)             if (dphi >= 0.D0) then ! outflow only
  1277)               ukvr = auxvar%kvr(np)
  1278)               if (ukvr < 1e-20) ukvr=0D0
  1279)               v_darcy = 0D0
  1280)               if (ukvr*Dq > floweps) then
  1281)                 v_darcy = Dq * ukvr * dphi
  1282)                 ! store volumetric rate for ss_fluid_fluxes()
  1283)                 qsrc_phase(1) = -1.d0*v_darcy
  1284)                 Res(1) = Res(1) - v_darcy* auxvar%den(np)* &
  1285)                   auxvar%xmol((np-1)*option%nflowspec+1)*option%flow_dt
  1286)                 Res(2) = Res(2) - v_darcy* auxvar%den(np)* &
  1287)                   auxvar%xmol((np-1)*option%nflowspec+2)*option%flow_dt
  1288)                 if (energy_flag) Res(3) = Res(3) - v_darcy * auxvar%den(np)* &
  1289)                   auxvar%h(np)*option%flow_dt
  1290)               ! print *,'produce: ',np,v_darcy
  1291)               endif
  1292)             endif
  1293)           enddo
  1294)         endif
  1295)       endif 
  1296)      !print *,'well-prod: ',  auxvar%pres,psrc(1), res
  1297)     ! injection well (well status = 2)
  1298)       if (dabs(well_status - 2D0) < 1D-1) then
  1299) 
  1300)         call EOSWaterDensity(tsrc,auxvar%pres,dw_kg,dw_mol,ierr)
  1301)         call EOSWaterEnthalpy(tsrc,auxvar%pres,enth_src_h2o,ierr)
  1302)         enth_src_h2o = enth_src_h2o * option%scale ! J/kmol -> whatever units
  1303)         Dq = msrc(2) ! well parameter, read in input file
  1304)                       ! Take the place of 2nd parameter 
  1305)         ! Flow term
  1306)         if (auxvar%pres < pressure_max) then
  1307)           do np = 1, option%nphase
  1308)             dphi = pressure_bh - auxvar%pres + auxvar%pc(np)
  1309)             if (dphi >= 0.D0) then ! outflow only
  1310)               ukvr = auxvar%kvr(np)
  1311)               v_darcy=0.D0
  1312)               if (ukvr*Dq > floweps) then
  1313)                 v_darcy = Dq * ukvr * dphi
  1314)                 ! store volumetric rate for ss_fluid_fluxes()
  1315)                 qsrc_phase(1) = v_darcy
  1316)                 Res(1) = Res(1) + v_darcy* auxvar%den(np)* &
  1317) !                 auxvar%xmol((np-1)*option%nflowspec+1) * option%flow_dt
  1318)                   (1.d0-csrc) * option%flow_dt
  1319)                 Res(2) = Res(2) + v_darcy* auxvar%den(np)* &
  1320) !                 auxvar%xmol((np-1)*option%nflowspec+2) * option%flow_dt
  1321)                   csrc * option%flow_dt
  1322) !               if (energy_flag) Res(3) = Res(3) + v_darcy*auxvar%den(np)*auxvar%h(np)*option%flow_dt
  1323)                 if (energy_flag) Res(3) = Res(3) + v_darcy*auxvar%den(np)* &
  1324)                   enth_src_h2o*option%flow_dt
  1325)                 
  1326) !               print *,'inject: ',np,v_darcy
  1327)               endif
  1328)             endif
  1329)           enddo
  1330)         endif
  1331)       endif    
  1332)     case default
  1333)     print *,'Unrecognized Source/Sink condition: ', isrctype 
  1334)   end select      
  1335) !  deallocate(msrc)
  1336)   
  1337) end subroutine Flash2SourceSink
  1338) 
  1339) ! ************************************************************************** !
  1340) 
  1341) subroutine Flash2Flux(auxvar_up,por_up,tor_up,sir_up,dd_up,perm_up,Dk_up, &
  1342)                         auxvar_dn,por_dn,tor_dn,sir_dn,dd_dn,perm_dn,Dk_dn, &
  1343)                         area,dist_gravity,upweight, &
  1344)                         option,vv_darcy,Res)
  1345)   ! 
  1346)   ! Computes the internal flux terms for the residual
  1347)   ! 
  1348)   ! Author: Chuan Lu
  1349)   ! Date: 10/12/08
  1350)   ! 
  1351)   use Option_module                              
  1352)   
  1353)   implicit none
  1354)   
  1355)   type(Flash2_auxvar_elem_type) :: auxvar_up, auxvar_dn
  1356)   type(option_type) :: option
  1357)   PetscReal :: sir_up(:), sir_dn(:)
  1358)   PetscReal :: por_up, por_dn
  1359)   PetscReal :: tor_up, tor_dn
  1360)   PetscReal :: dd_up, dd_dn
  1361)   PetscReal :: perm_up, perm_dn
  1362)   PetscReal :: Dk_up, Dk_dn
  1363)   PetscReal :: vv_darcy(:),area
  1364)   PetscReal :: Res(1:option%nflowdof) 
  1365)   PetscReal :: dist_gravity  ! distance along gravity vector
  1366)      
  1367)   PetscInt :: ispec, np, ind
  1368)   PetscReal :: fluxm(option%nflowspec),fluxe,q, v_darcy
  1369)   PetscReal :: uh,uxmol(1:option%nflowspec),ukvr,difff,diffdp, DK,Dq
  1370)   PetscReal :: upweight,density_ave,cond,gravity,dphi
  1371)      
  1372)   Dq = (perm_up * perm_dn)/(dd_up*perm_dn + dd_dn*perm_up)
  1373)   diffdp = (por_up *tor_up * por_dn*tor_dn) / (dd_dn*por_up*tor_up + dd_up*por_dn*tor_dn)*area
  1374)   
  1375)   fluxm = 0.D0
  1376)   fluxe = 0.D0
  1377)   vv_darcy =0.D0 
  1378)   
  1379) ! Flow term
  1380)   do np = 1, option%nphase
  1381) !   if (auxvar_up%sat(np) > sir_up(np) .or. auxvar_dn%sat(np) > sir_dn(np)) then
  1382)     if ((auxvar_up%kvr(np) + auxvar_dn%kvr(np)) > eps) then
  1383)       upweight= dd_dn/(dd_up+dd_dn)
  1384)       if (auxvar_up%sat(np) < eps) then
  1385)         upweight=0.d0
  1386)       else if (auxvar_dn%sat(np) < eps) then
  1387)         upweight=1.d0
  1388)       endif
  1389)       density_ave = upweight*auxvar_up%den(np) + (1.D0-upweight)*auxvar_dn%den(np)
  1390)         
  1391)       gravity = (upweight*auxvar_up%den(np) * auxvar_up%avgmw(np) + &
  1392)              (1.D0-upweight)*auxvar_dn%den(np) * auxvar_dn%avgmw(np)) &
  1393)              * dist_gravity
  1394) 
  1395)       dphi = auxvar_up%pres - auxvar_dn%pres &
  1396)              - auxvar_up%pc(np) + auxvar_dn%pc(np) &
  1397)              + gravity
  1398) 
  1399)       v_darcy = 0.D0
  1400)       ukvr = 0.D0
  1401)       uh = 0.D0
  1402)       uxmol = 0.D0
  1403) 
  1404)       ! note uxmol only contains one phase xmol
  1405)       if (dphi >= 0.D0) then
  1406)         ukvr = auxvar_up%kvr(np)
  1407)         uxmol(:)=auxvar_up%xmol((np-1)*option%nflowspec+1 : np * option%nflowspec)
  1408)            ! if (option%use_isothermal == PETSC_FALSE)&
  1409)         uh = auxvar_up%h(np)
  1410)       else
  1411)         ukvr = auxvar_dn%kvr(np)
  1412)         uxmol(:)=auxvar_dn%xmol((np-1)*option%nflowspec+1 : np * option%nflowspec)
  1413)            ! if (option%use_isothermal == PETSC_FALSE)&
  1414)         uh = auxvar_dn%h(np)
  1415)       endif
  1416)    
  1417) 
  1418)       if (ukvr>floweps) then
  1419)         v_darcy= Dq * ukvr * dphi
  1420)         vv_darcy(np) = v_darcy
  1421)         q = v_darcy * area
  1422)         do ispec = 1, option%nflowspec
  1423)           fluxm(ispec) = fluxm(ispec) + q * density_ave * uxmol(ispec)
  1424)         enddo
  1425)         ! if (option%use_isothermal == PETSC_FALSE) &
  1426)         fluxe = fluxe + q*density_ave*uh
  1427)       endif
  1428)     endif
  1429) 
  1430) #if 1 
  1431) ! Diffusion term   
  1432) ! Note : average rule may not be correct  
  1433)     if ((auxvar_up%sat(np) > eps) .and. (auxvar_dn%sat(np) > eps)) then
  1434)       difff = diffdp * 0.25D0*(auxvar_up%sat(np) + auxvar_dn%sat(np))* &
  1435)              (auxvar_up%den(np) + auxvar_dn%den(np))
  1436)       do ispec=1, option%nflowspec
  1437)         ind = ispec + (np-1)*option%nflowspec
  1438)         fluxm(ispec) = fluxm(ispec) + difff * .5D0 * &
  1439)             (auxvar_up%diff(ind) + auxvar_dn%diff(ind))* &
  1440)             (auxvar_up%xmol(ind) - auxvar_dn%xmol(ind))
  1441)       enddo
  1442)     endif
  1443) #endif
  1444)   enddo
  1445) 
  1446) ! conduction term
  1447)   !if (option%use_isothermal == PETSC_FALSE) then     
  1448)   Dk = (Dk_up * Dk_dn) / (dd_dn*Dk_up + dd_up*Dk_dn)
  1449)   cond = Dk*area*(auxvar_up%temp-auxvar_dn%temp)
  1450)   fluxe=fluxe + cond
  1451)  ! end if
  1452) 
  1453)   !if (option%use_isothermal)then
  1454)   !   Res(1:option%nflowdof) = fluxm(:) * option%flow_dt
  1455)  ! else
  1456)   Res(1:option%nflowspec) = fluxm(:) * option%flow_dt
  1457)    ! if (option%use_isothermal == PETSC_FALSE)&
  1458)   Res(option%nflowdof) = fluxe * option%flow_dt
  1459)  ! end if
  1460)  ! note: Res is the flux contribution, for node 1 R = R + Res_FL
  1461)  !                                              2 R = R - Res_FL  
  1462) 
  1463) end subroutine Flash2Flux
  1464) 
  1465) ! ************************************************************************** !
  1466) 
  1467) subroutine Flash2FluxAdv(auxvar_up,por_up,tor_up,sir_up,dd_up,perm_up,Dk_up, &
  1468)                         auxvar_dn,por_dn,tor_dn,sir_dn,dd_dn,perm_dn,Dk_dn, &
  1469)                         area,dist_gravity,upweight, &
  1470)                         option,vv_darcy,Res)
  1471)   ! 
  1472)   ! Flash2Flux: Computes the internal flux terms for the residual
  1473)   ! 
  1474)   ! Author: Chuan Lu
  1475)   ! Date: 05/04/10
  1476)   ! 
  1477)   use Option_module                              
  1478)   
  1479)   implicit none
  1480)   
  1481)   type(Flash2_auxvar_elem_type) :: auxvar_up, auxvar_dn
  1482)   type(option_type) :: option
  1483)   PetscReal :: sir_up(:), sir_dn(:)
  1484)   PetscReal :: por_up, por_dn
  1485)   PetscReal :: tor_up, tor_dn
  1486)   PetscReal :: dd_up, dd_dn
  1487)   PetscReal :: perm_up, perm_dn
  1488)   PetscReal :: Dk_up, Dk_dn
  1489)   PetscReal :: vv_darcy(:),area
  1490)   PetscReal :: Res(1:option%nflowdof) 
  1491)   PetscReal :: dist_gravity  ! distance along gravity vector
  1492)      
  1493)   PetscInt :: ispec, np, ind
  1494)   PetscReal :: fluxm(option%nflowspec),fluxe,q, v_darcy
  1495)   PetscReal :: uh,uxmol(1:option%nflowspec),ukvr,difff,diffdp, DK,Dq
  1496)   PetscReal :: upweight,density_ave,cond,gravity,dphi
  1497)      
  1498)   Dq = (perm_up * perm_dn)/(dd_up*perm_dn + dd_dn*perm_up)
  1499) !  diffdp = (por_up *tor_up * por_dn*tor_dn) / (dd_dn*por_up*tor_up + dd_up*por_dn*tor_dn)*area
  1500)   
  1501)   fluxm = 0.D0
  1502)   fluxe = 0.D0
  1503)   vv_darcy =0.D0 
  1504)   
  1505) ! Flow term
  1506)   do np = 1, option%nphase
  1507)     if (auxvar_up%sat(np) > sir_up(np) .or. auxvar_dn%sat(np) > sir_dn(np)) then
  1508)       upweight= dd_dn/(dd_up+dd_dn)
  1509)       if (auxvar_up%sat(np) <eps) then
  1510)         upweight=0.d0
  1511)       else if (auxvar_dn%sat(np) <eps) then
  1512)         upweight=1.d0
  1513)       endif
  1514)       density_ave = upweight*auxvar_up%den(np) + (1.D0-upweight)*auxvar_dn%den(np)
  1515)         
  1516)       gravity = (upweight*auxvar_up%den(np) * auxvar_up%avgmw(np) + &
  1517)           (1.D0-upweight)*auxvar_dn%den(np) * auxvar_dn%avgmw(np)) &
  1518)           * dist_gravity
  1519) 
  1520)       dphi = auxvar_up%pres - auxvar_dn%pres &
  1521)              - auxvar_up%pc(np) + auxvar_dn%pc(np) &
  1522)              + gravity
  1523) 
  1524)       v_darcy = 0.D0
  1525)       ukvr=0.D0
  1526)       uh=0.D0
  1527)       uxmol=0.D0
  1528) 
  1529)         ! note uxmol only contains one phase xmol
  1530)       if (dphi >= 0.D0) then
  1531)         ukvr = auxvar_up%kvr(np)
  1532)         uxmol(:)=auxvar_up%xmol((np-1)*option%nflowspec+1 : np * option%nflowspec)
  1533)            ! if (option%use_isothermal == PETSC_FALSE)&
  1534)         uh = auxvar_up%h(np)
  1535)       else
  1536)         ukvr = auxvar_dn%kvr(np)
  1537)         uxmol(:)=auxvar_dn%xmol((np-1)*option%nflowspec+1 : np * option%nflowspec)
  1538)            ! if (option%use_isothermal == PETSC_FALSE)&
  1539)         uh = auxvar_dn%h(np)
  1540)       endif
  1541)    
  1542) 
  1543)       if (ukvr>floweps) then
  1544)         v_darcy= Dq * ukvr * dphi
  1545)         vv_darcy(np)=v_darcy
  1546)         q = v_darcy * area
  1547)         do ispec =1, option%nflowspec
  1548)           fluxm(ispec)=fluxm(ispec) + q * density_ave * uxmol(ispec)
  1549)         enddo
  1550)         ! if (option%use_isothermal == PETSC_FALSE)&
  1551)         fluxe = fluxe + q*density_ave*uh
  1552)       endif
  1553)     endif
  1554)   end do
  1555)      
  1556)   Res(1:option%nflowspec) = fluxm(:) * option%flow_dt
  1557) !  if (option%use_isothermal == PETSC_FALSE)&
  1558)   Res(option%nflowdof) = fluxe * option%flow_dt
  1559)  ! end if
  1560)  ! note: Res is the flux contribution, for node 1 R = R + Res_FL
  1561)  !                                              2 R = R - Res_FL  
  1562) 
  1563) end subroutine Flash2FluxAdv
  1564) 
  1565) ! ************************************************************************** !
  1566) 
  1567) subroutine Flash2FluxDiffusion(auxvar_up,por_up,tor_up,sir_up,dd_up,perm_up,Dk_up, &
  1568)                         auxvar_dn,por_dn,tor_dn,sir_dn,dd_dn,perm_dn,Dk_dn, &
  1569)                         area,dist_gravity,upweight, &
  1570)                         option,vv_darcy,Res)
  1571)   ! 
  1572)   ! Flash2Flux: Computes the internal flux terms for the residual
  1573)   ! 
  1574)   ! Author: Chuan Lu
  1575)   ! Date: 10/12/08
  1576)   ! 
  1577)   use Option_module                              
  1578)   
  1579)   implicit none
  1580)   
  1581)   type(Flash2_auxvar_elem_type) :: auxvar_up, auxvar_dn
  1582)   type(option_type) :: option
  1583)   PetscReal :: sir_up(:), sir_dn(:)
  1584)   PetscReal :: por_up, por_dn
  1585)   PetscReal :: tor_up, tor_dn
  1586)   PetscReal :: dd_up, dd_dn
  1587)   PetscReal :: perm_up, perm_dn
  1588)   PetscReal :: Dk_up, Dk_dn
  1589)   PetscReal :: vv_darcy(:),area
  1590)   PetscReal :: Res(1:option%nflowdof) 
  1591)   PetscReal :: dist_gravity  ! distance along gravity vector
  1592)      
  1593)   PetscInt :: ispec, np, ind
  1594)   PetscReal :: fluxm(option%nflowspec),fluxe,q, v_darcy
  1595)   PetscReal :: uh,uxmol(1:option%nflowspec),ukvr,difff,diffdp, DK,Dq
  1596)   PetscReal :: upweight,density_ave,cond,gravity,dphi
  1597)      
  1598) 
  1599)   diffdp = (por_up *tor_up * por_dn*tor_dn) / (dd_dn*por_up*tor_up + dd_up*por_dn*tor_dn)*area
  1600)   
  1601)   fluxm = 0.D0
  1602)   fluxe = 0.D0
  1603)   vv_darcy =0.D0 
  1604)   
  1605) ! Flow term
  1606)   do np = 1, option%nphase
  1607)  
  1608) ! Diffusion term   
  1609) ! Note : average rule may not be correct  
  1610)     if ((auxvar_up%sat(np) > eps) .and. (auxvar_dn%sat(np) > eps)) then
  1611)       difff = diffdp * 0.25D0*(auxvar_up%sat(np) + auxvar_dn%sat(np))* &
  1612)              (auxvar_up%den(np) + auxvar_dn%den(np))
  1613)       do ispec=1, option%nflowspec
  1614)         ind = ispec + (np-1)*option%nflowspec
  1615)         fluxm(ispec) = fluxm(ispec) + difff * .5D0 * &
  1616)           (auxvar_up%diff(ind) + auxvar_dn%diff(ind))* &
  1617)           (auxvar_up%xmol(ind) - auxvar_dn%xmol(ind))
  1618)       enddo
  1619)     endif
  1620)   enddo
  1621) 
  1622) ! conduction term
  1623)   !if (option%use_isothermal == PETSC_FALSE) then     
  1624)   Dk = (Dk_up * Dk_dn) / (dd_dn*Dk_up + dd_up*Dk_dn)
  1625)   cond = Dk*area*(auxvar_up%temp-auxvar_dn%temp)
  1626)   fluxe=fluxe + cond
  1627)  ! end if
  1628) 
  1629)   !if (option%use_isothermal)then
  1630)   !   Res(1:option%nflowdof) = fluxm(:) * option%flow_dt
  1631)  ! else
  1632)   Res(1:option%nflowspec) = fluxm(:) * option%flow_dt
  1633)  ! if (option%use_isothermal)    
  1634)   Res(option%nflowdof) = fluxe * option%flow_dt
  1635)  ! end if
  1636)  ! note: Res is the flux contribution, for node 1 R = R + Res_FL
  1637)  !                                              2 R = R - Res_FL  
  1638) 
  1639) end subroutine Flash2FluxDiffusion
  1640) 
  1641) ! ************************************************************************** !
  1642) 
  1643) subroutine Flash2BCFlux(ibndtype,auxvars,auxvar_up,auxvar_dn, &
  1644)      por_dn,tor_dn,sir_dn,dd_up,perm_dn,Dk_dn, &
  1645)      area,dist_gravity,option,vv_darcy,Res)
  1646)   ! 
  1647)   ! Computes the  boundary flux terms for the residual
  1648)   ! 
  1649)   ! Author: Chuan Lu
  1650)   ! Date: 10/12/08
  1651)   ! 
  1652)   use Option_module
  1653)   
  1654)   implicit none
  1655)   
  1656)   PetscInt :: ibndtype(:)
  1657)   type(Flash2_auxvar_elem_type) :: auxvar_up, auxvar_dn
  1658)   type(option_type) :: option
  1659)   PetscReal :: dd_up, sir_dn(:)
  1660)   PetscReal :: auxvars(:) ! from aux_real_var array
  1661)   PetscReal :: por_dn,perm_dn,Dk_dn,tor_dn
  1662)   PetscReal :: vv_darcy(:), area
  1663)   PetscReal :: Res(1:option%nflowdof) 
  1664)   
  1665)   PetscReal :: dist_gravity  ! distance along gravity vector
  1666)           
  1667)   PetscInt :: ispec, np
  1668)   PetscReal :: fluxm(option%nflowspec),fluxe,q,density_ave, v_darcy
  1669)   PetscReal :: uh,uxmol(1:option%nflowspec),ukvr,diff,diffdp,DK,Dq
  1670)   PetscReal :: upweight,cond,gravity,dphi
  1671)   
  1672)   fluxm = 0.d0
  1673)   fluxe = 0.d0
  1674)   v_darcy = 0.d0
  1675)   density_ave = 0.d0
  1676)   q = 0.d0
  1677) 
  1678)   ! Flow   
  1679)   diffdp = por_dn*tor_dn/dd_up*area
  1680)   do np = 1, option%nphase  
  1681)     select case(ibndtype(1))
  1682)         ! figure out the direction of flow
  1683)     case(DIRICHLET_BC,HYDROSTATIC_BC,SEEPAGE_BC)
  1684)       Dq = perm_dn / dd_up
  1685)         ! Flow term
  1686)       ukvr=0.D0
  1687)       v_darcy=0.D0
  1688) !     if (auxvar_up%sat(np) > sir_dn(np) .or. auxvar_dn%sat(np) > sir_dn(np)) then
  1689)       if ((auxvar_up%kvr(np) + auxvar_dn%kvr(np)) > eps) then
  1690)         upweight=1.D0
  1691)         if (auxvar_up%sat(np) < eps) then
  1692)           upweight=0.d0
  1693)         else if (auxvar_dn%sat(np) < eps) then
  1694)               upweight=1.d0
  1695)         endif
  1696)         density_ave = upweight*auxvar_up%den(np) + (1.D0-upweight)*auxvar_dn%den(np)
  1697) !           print *,'flbc den:', upweight, auxvar_up%den(np), auxvar_dn%den(np)
  1698)         gravity = (upweight*auxvar_up%den(np) * auxvar_up%avgmw(np) + &
  1699)                 (1.D0-upweight)*auxvar_dn%den(np) * auxvar_dn%avgmw(np)) &
  1700)                 * dist_gravity
  1701)        
  1702)         dphi = auxvar_up%pres - auxvar_dn%pres &
  1703)                 - auxvar_up%pc(np) + auxvar_dn%pc(np) &
  1704)                 + gravity
  1705)    
  1706)         if (dphi >= 0.D0) then
  1707)           ukvr = auxvar_up%kvr(np)
  1708)         else
  1709)           ukvr = auxvar_dn%kvr(np)
  1710)         endif
  1711)      
  1712)         if (ukvr*Dq>floweps) then
  1713)           v_darcy = Dq * ukvr * dphi
  1714)         endif
  1715)       endif
  1716) 
  1717)     case(NEUMANN_BC) !may not work
  1718)       v_darcy = 0.D0
  1719)       if (dabs(auxvars(1)) > floweps) then
  1720)         v_darcy = auxvars(MPH_PRESSURE_DOF)
  1721)         if (v_darcy > 0.d0) then
  1722)           density_ave = auxvar_up%den(np)
  1723)         else
  1724)           density_ave = auxvar_dn%den(np)
  1725)         endif
  1726)       endif
  1727) 
  1728)     end select
  1729)      
  1730)     q = v_darcy * area
  1731)     vv_darcy(np) = v_darcy
  1732)     uh=0.D0
  1733)     uxmol=0.D0
  1734)      
  1735)     if (v_darcy >= 0.D0) then
  1736)         !if (option%use_isothermal == PETSC_FALSE)&
  1737)       uh = auxvar_up%h(np)
  1738)       uxmol(:)=auxvar_up%xmol((np-1)*option%nflowspec+1 : np * option%nflowspec)
  1739)     else
  1740)          !if (option%use_isothermal == PETSC_FALSE)&
  1741)       uh = auxvar_dn%h(np)
  1742)       uxmol(:)=auxvar_dn%xmol((np-1)*option%nflowspec+1 : np * option%nflowspec)
  1743)     endif
  1744)     do ispec=1, option%nflowspec
  1745)       fluxm(ispec) = fluxm(ispec) + q*density_ave * uxmol(ispec)
  1746)     end do
  1747)       !if (option%use_isothermal == PETSC_FALSE) &
  1748)     fluxe = fluxe + q*density_ave*uh
  1749) !     print *,'FLBC', ibndtype(1),np, ukvr, v_darcy, uh, uxmol, density_ave
  1750)   enddo
  1751) 
  1752) #if 1 
  1753)     ! Diffusion term   
  1754)   select case(ibndtype(3))
  1755)   case(DIRICHLET_BC) 
  1756)      !if (auxvar_up%sat > eps .and. auxvar_dn%sat > eps) then
  1757)      !  diff = diffdp * 0.25D0*(auxvar_up%sat+auxvar_dn%sat)* &
  1758)      !  (auxvar_up%den+auxvar_dn%den)
  1759)     do np = 1, option%nphase
  1760)       if (auxvar_up%sat(np)>eps .and. auxvar_dn%sat(np)>eps) then
  1761)         diff = diffdp * 0.25D0*(auxvar_up%sat(np)+auxvar_dn%sat(np))* &
  1762)               (auxvar_up%den(np)+auxvar_up%den(np))
  1763)         do ispec = 1, option%nflowspec
  1764)           fluxm(ispec) = fluxm(ispec) + diff * &
  1765)                    auxvar_dn%diff((np-1)* option%nflowspec+ispec)* &
  1766)                    (auxvar_up%xmol((np-1)* option%nflowspec+ispec) &
  1767)                    -auxvar_dn%xmol((np-1)* option%nflowspec+ispec))
  1768)         enddo
  1769)       endif
  1770)     enddo
  1771)   end select
  1772) #endif
  1773)   ! Conduction term
  1774) ! if (option%use_isothermal == PETSC_FALSE) then
  1775)   select case(ibndtype(2))
  1776)     case(DIRICHLET_BC)
  1777)       Dk =  Dk_dn / dd_up
  1778)       cond = Dk*area*(auxvar_up%temp - auxvar_dn%temp)
  1779)       fluxe = fluxe + cond
  1780)     case(NEUMANN_BC)
  1781)       fluxe = fluxe + auxvars(2)*area*option%scale
  1782)     case(ZERO_GRADIENT_BC)
  1783)       ! No change in fluxe
  1784)   end select
  1785) ! end if
  1786) 
  1787)   Res(1:option%nflowspec)=fluxm(:)* option%flow_dt
  1788)   Res(option%nflowdof)=fluxe * option%flow_dt
  1789) 
  1790) end subroutine Flash2BCFlux
  1791) 
  1792) ! ************************************************************************** !
  1793) 
  1794) subroutine Flash2BCFluxAdv(ibndtype,auxvars,auxvar_up,auxvar_dn, &
  1795)      por_dn,tor_dn,sir_dn,dd_up,perm_dn,Dk_dn, &
  1796)      area,dist_gravity,option,vv_darcy,Res)
  1797)   ! 
  1798)   ! Computes the  boundary flux terms for the residual
  1799)   ! 
  1800)   ! Author: Chuan Lu
  1801)   ! Date: 10/12/08
  1802)   ! 
  1803)   use Option_module
  1804)   
  1805)   implicit none
  1806)   
  1807)   PetscInt :: ibndtype(:)
  1808)   type(Flash2_auxvar_elem_type) :: auxvar_up, auxvar_dn
  1809)   type(option_type) :: option
  1810)   PetscReal :: dd_up, sir_dn(:)
  1811)   PetscReal :: auxvars(:) ! from aux_real_var array
  1812)   PetscReal :: por_dn,perm_dn,Dk_dn,tor_dn
  1813)   PetscReal :: vv_darcy(:), area
  1814)   PetscReal :: Res(1:option%nflowdof) 
  1815)   
  1816)   PetscReal :: dist_gravity  ! distance along gravity vector
  1817)           
  1818)   PetscInt :: ispec, np
  1819)   PetscReal :: fluxm(option%nflowspec),fluxe,q,density_ave, v_darcy
  1820)   PetscReal :: uh,uxmol(1:option%nflowspec),ukvr,diff,diffdp,DK,Dq
  1821)   PetscReal :: upweight,cond,gravity,dphi
  1822)   
  1823)   fluxm = 0.d0
  1824)   fluxe = 0.d0
  1825)   v_darcy = 0.d0
  1826)   density_ave = 0.d0
  1827)   q = 0.d0
  1828) 
  1829)   ! Flow   
  1830) !  diffdp = por_dn*tor_dn/dd_up*area
  1831)   do np = 1, option%nphase  
  1832)     select case(ibndtype(1))
  1833)         ! figure out the direction of flow
  1834)     case(DIRICHLET_BC,HYDROSTATIC_BC,SEEPAGE_BC)
  1835)       Dq = perm_dn / dd_up
  1836)         ! Flow term
  1837)       ukvr = 0.D0
  1838)       v_darcy = 0.D0
  1839)       if (auxvar_up%sat(np) > sir_dn(np) .or. auxvar_dn%sat(np) > sir_dn(np)) then
  1840)         upweight = 1.D0
  1841)         if (auxvar_up%sat(np) < eps) then
  1842)           upweight = 0.d0
  1843)         else if (auxvar_dn%sat(np) < eps) then
  1844)           upweight = 1.d0
  1845)         endif
  1846)         density_ave = upweight*auxvar_up%den(np) + (1.D0-upweight)*auxvar_dn%den(np)
  1847)            
  1848)         gravity = (upweight*auxvar_up%den(np) * auxvar_up%avgmw(np) + &
  1849)                 (1.D0-upweight)*auxvar_dn%den(np) * auxvar_dn%avgmw(np)) &
  1850)                 * dist_gravity
  1851)        
  1852)         dphi = auxvar_up%pres - auxvar_dn%pres &
  1853)                 - auxvar_up%pc(np) + auxvar_dn%pc(np) &
  1854)                 + gravity
  1855)    
  1856)         if (dphi >= 0.D0) then
  1857)           ukvr = auxvar_up%kvr(np)
  1858)         else
  1859)           ukvr = auxvar_dn%kvr(np)
  1860)         endif
  1861)      
  1862)         if (ukvr*Dq > floweps) then
  1863)           v_darcy = Dq * ukvr * dphi
  1864)         endif
  1865)       endif
  1866) 
  1867)     case(NEUMANN_BC)
  1868)       v_darcy = 0.D0
  1869)       if (dabs(auxvars(1)) > floweps) then
  1870)         v_darcy = auxvars(MPH_PRESSURE_DOF)
  1871)         if (v_darcy > 0.d0) then
  1872)           density_ave = auxvar_up%den(np)
  1873)         else
  1874)           density_ave = auxvar_dn%den(np)
  1875)         endif
  1876)       endif
  1877) 
  1878)     end select
  1879)      
  1880)     q = v_darcy * area
  1881)     vv_darcy(np) = v_darcy
  1882)     uh=0.D0
  1883)     uxmol=0.D0
  1884)      
  1885)     if (v_darcy >= 0.D0) then
  1886)         !if (option%use_isothermal == PETSC_FALSE)&
  1887)       uh = auxvar_up%h(np)
  1888)       uxmol(:)=auxvar_up%xmol((np-1)*option%nflowspec+1 : np * option%nflowspec)
  1889)     else
  1890)          !if (option%use_isothermal == PETSC_FALSE)&
  1891)       uh = auxvar_dn%h(np)
  1892)       uxmol(:)=auxvar_dn%xmol((np-1)*option%nflowspec+1 : np * option%nflowspec)
  1893)     endif
  1894)     do ispec=1, option%nflowspec
  1895)       fluxm(ispec) = fluxm(ispec) + q*density_ave * uxmol(ispec)
  1896)     end do
  1897) 
  1898)       !if (option%use_isothermal == PETSC_FALSE) &
  1899)     fluxe = fluxe + q*density_ave*uh
  1900)  !print *,'FLBC', ibndtype(1),np, ukvr, v_darcy, uh, uxmol
  1901)   enddo
  1902) 
  1903)   Res(1:option%nflowspec)=fluxm(:)* option%flow_dt
  1904)   Res(option%nflowdof)=fluxe * option%flow_dt
  1905) 
  1906) end subroutine Flash2BCFluxAdv
  1907) 
  1908) ! ************************************************************************** !
  1909) 
  1910) subroutine Flash2BCFluxDiffusion(ibndtype,auxvars,auxvar_up,auxvar_dn, &
  1911)      por_dn,tor_dn,sir_dn,dd_up,perm_dn,Dk_dn, &
  1912)      area,dist_gravity,option,vv_darcy,Res)
  1913)   ! 
  1914)   ! Computes the  boundary flux terms for the residual
  1915)   ! 
  1916)   ! Author: Chuan Lu
  1917)   ! Date: 10/12/08
  1918)   ! 
  1919)   use Option_module
  1920)   
  1921)   implicit none
  1922)   
  1923)   PetscInt :: ibndtype(:)
  1924)   type(Flash2_auxvar_elem_type) :: auxvar_up, auxvar_dn
  1925)   type(option_type) :: option
  1926)   PetscReal :: dd_up, sir_dn(:)
  1927)   PetscReal :: auxvars(:) ! from aux_real_var array
  1928)   PetscReal :: por_dn,perm_dn,Dk_dn,tor_dn
  1929)   PetscReal :: vv_darcy(:), area
  1930)   PetscReal :: Res(1:option%nflowdof) 
  1931)   
  1932)   PetscReal :: dist_gravity  ! distance along gravity vector
  1933)           
  1934)   PetscInt :: ispec, np
  1935)   PetscReal :: fluxm(option%nflowspec),fluxe,q,density_ave, v_darcy
  1936)   PetscReal :: uh,uxmol(1:option%nflowspec),ukvr,diff,diffdp,DK,Dq
  1937)   PetscReal :: upweight,cond,gravity,dphi
  1938)   
  1939)   fluxm = 0.d0
  1940)   fluxe = 0.d0
  1941)   v_darcy = 0.d0
  1942)   density_ave = 0.d0
  1943)   q = 0.d0
  1944) 
  1945) ! Diffusion term   
  1946)   diffdp = por_dn*tor_dn/dd_up*area
  1947)   select case(ibndtype(3))
  1948)   case(DIRICHLET_BC) 
  1949)      !      if (auxvar_up%sat > eps .and. auxvar_dn%sat > eps) then
  1950)      !        diff = diffdp * 0.25D0*(auxvar_up%sat+auxvar_dn%sat)*(auxvar_up%den+auxvar_dn%den)
  1951)     do np = 1, option%nphase
  1952)       if (auxvar_up%sat(np)>eps .and. auxvar_dn%sat(np) > eps) then
  1953)               diff =diffdp * 0.25D0*(auxvar_up%sat(np)+auxvar_dn%sat(np))*&
  1954)                     (auxvar_up%den(np)+auxvar_up%den(np))
  1955)         do ispec = 1, option%nflowspec
  1956)               fluxm(ispec) = fluxm(ispec) + diff * auxvar_dn%diff((np-1)* option%nflowspec+ispec)* &
  1957)                    (auxvar_up%xmol((np-1)* option%nflowspec+ispec) &
  1958)                    -auxvar_dn%xmol((np-1)* option%nflowspec+ispec))
  1959)         enddo
  1960)       endif
  1961)     enddo
  1962)      
  1963)   end select
  1964) ! Conduction term
  1965) ! if (option%use_isothermal == PETSC_FALSE) then
  1966)   select case(ibndtype(2))
  1967)   case(DIRICHLET_BC, 4)
  1968)     Dk = Dk_dn / dd_up
  1969)     cond = Dk*area*(auxvar_up%temp - auxvar_dn%temp)
  1970)     fluxe = fluxe + cond
  1971)   end select
  1972) ! end if
  1973) 
  1974)   Res(1:option%nflowspec)=fluxm(:)* option%flow_dt
  1975)   Res(option%nflowdof)=fluxe * option%flow_dt
  1976) 
  1977) end subroutine Flash2BCFluxDiffusion
  1978) 
  1979) ! ************************************************************************** !
  1980) 
  1981) subroutine Flash2Residual(snes,xx,r,realization,ierr)
  1982)   ! 
  1983)   ! Computes the residual equation
  1984)   ! 
  1985)   ! Author: Chuan Lu
  1986)   ! Date: 10/10/08
  1987)   ! 
  1988) 
  1989)   use Realization_Subsurface_class
  1990)   use Patch_module
  1991)   use Discretization_module
  1992)   use Field_module
  1993)   use Option_module
  1994)   use Grid_module 
  1995)   use Logging_module
  1996)   use Material_module
  1997)   use Variables_module, only : PERMEABILITY_X, PERMEABILITY_Y, PERMEABILITY_Z
  1998)   use Debug_module
  1999) 
  2000)   implicit none
  2001) 
  2002)   SNES :: snes
  2003)   Vec :: xx
  2004)   Vec :: r
  2005)   type(realization_subsurface_type) :: realization
  2006)   PetscViewer :: viewer
  2007)   PetscErrorCode :: ierr
  2008)   
  2009)   type(discretization_type), pointer :: discretization
  2010)   type(option_type), pointer :: option
  2011)   type(grid_type), pointer :: grid
  2012)   type(field_type), pointer :: field
  2013)   type(patch_type), pointer :: patch
  2014)   PetscInt :: ichange  
  2015)   character(len=MAXSTRINGLENGTH) :: string
  2016) 
  2017)   field => realization%field
  2018)   grid => realization%patch%grid
  2019)   option => realization%option
  2020)   discretization => realization%discretization
  2021)   patch => realization%patch
  2022)   
  2023)   call PetscLogEventBegin(logging%event_r_residual,ierr);CHKERRQ(ierr)
  2024)  
  2025)   call DiscretizationGlobalToLocal(discretization,xx,field%flow_xx_loc,NFLOWDOF)
  2026) 
  2027)  ! check initial guess -----------------------------------------------
  2028)   ierr = Flash2InitGuessCheck(realization)
  2029)   if (ierr<0)then
  2030)     !ierr = PETSC_ERR_ARG_OUTOFRANGE
  2031)     if (option%myrank==0) print *,'table out of range: ',ierr
  2032)     call SNESSetFunctionDomainError(snes,ierr);CHKERRQ(ierr)
  2033)     return
  2034)   endif 
  2035)   ! end check ---------------------------------------------------------
  2036) 
  2037)   ! Communication -----------------------------------------
  2038)   ! These 3 must be called before Flash2UpdateAuxVars()
  2039) !  call DiscretizationGlobalToLocal(discretization,xx,field%flow_xx_loc,NFLOWDOF)
  2040)   call DiscretizationLocalToLocal(discretization,field%icap_loc,field%icap_loc,ONEDOF)
  2041) 
  2042)   call MaterialGetAuxVarVecLoc(patch%aux%Material,field%work_loc, &
  2043)                                PERMEABILITY_X,ZERO_INTEGER)
  2044)   call DiscretizationLocalToLocal(discretization,field%work_loc, &
  2045)                                   field%work_loc,ONEDOF)
  2046)   call MaterialSetAuxVarVecLoc(patch%aux%Material,field%work_loc, &
  2047)                                PERMEABILITY_X,ZERO_INTEGER)
  2048)   call MaterialGetAuxVarVecLoc(patch%aux%Material,field%work_loc, &
  2049)                                PERMEABILITY_Y,ZERO_INTEGER)
  2050)   call DiscretizationLocalToLocal(discretization,field%work_loc, &
  2051)                                   field%work_loc,ONEDOF)
  2052)   call MaterialSetAuxVarVecLoc(patch%aux%Material,field%work_loc, &
  2053)                                PERMEABILITY_Y,ZERO_INTEGER)
  2054)   call MaterialGetAuxVarVecLoc(patch%aux%Material,field%work_loc, &
  2055)                                PERMEABILITY_Z,ZERO_INTEGER)
  2056)   call DiscretizationLocalToLocal(discretization,field%work_loc, &
  2057)                                   field%work_loc,ONEDOF)
  2058)   call MaterialSetAuxVarVecLoc(patch%aux%Material,field%work_loc, &
  2059)                                PERMEABILITY_Z,ZERO_INTEGER)
  2060) 
  2061)   call DiscretizationLocalToLocal(discretization,field%ithrm_loc,field%ithrm_loc,ONEDOF)
  2062) 
  2063) ! pass #0 prepare numerical increment  
  2064)   call Flash2ResidualPatch0(snes,xx,r,realization,ierr)
  2065) 
  2066) ! pass #1 internal and boundary flux terms
  2067)   call Flash2ResidualPatch1(snes,xx,r,realization,ierr)
  2068) 
  2069) ! pass #2 for everything else
  2070)   call Flash2ResidualPatch2(snes,xx,r,realization,ierr)
  2071) 
  2072)   if (realization%debug%vecview_residual) then
  2073)     string = 'Fresidual'
  2074)     call DebugCreateViewer(realization%debug,string,option,viewer)
  2075)     call VecView(r,viewer,ierr);CHKERRQ(ierr)
  2076)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  2077)   endif
  2078)   if (realization%debug%vecview_solution) then
  2079)     string = 'Fxx'
  2080)     call DebugCreateViewer(realization%debug,string,option,viewer)
  2081)     call VecView(xx,viewer,ierr);CHKERRQ(ierr)
  2082)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  2083)   endif
  2084)   
  2085)   call PetscLogEventEnd(logging%event_r_residual,ierr);CHKERRQ(ierr)
  2086) 
  2087) end subroutine Flash2Residual
  2088) 
  2089) ! ************************************************************************** !
  2090) 
  2091) subroutine Flash2ResidualPatch(snes,xx,r,realization,ierr)
  2092)   ! 
  2093)   ! Computes the residual equation at patch level
  2094)   ! original version (not used)
  2095)   ! 
  2096)   ! Author: Chuan Lu
  2097)   ! Date: 10/10/08
  2098)   ! 
  2099) 
  2100)   use Connection_module
  2101)   use Realization_Subsurface_class
  2102)   use Patch_module
  2103)   use Grid_module
  2104)   use Option_module
  2105)   use Coupler_module  
  2106)   use Field_module
  2107)   use Debug_module
  2108)   use Material_Aux_class
  2109)   
  2110)   implicit none
  2111) 
  2112)   SNES, intent(in) :: snes
  2113)   Vec, intent(inout) :: xx
  2114)   Vec, intent(out) :: r
  2115)   type(realization_subsurface_type) :: realization
  2116) 
  2117)   PetscErrorCode :: ierr
  2118)   PetscInt :: i, jn
  2119)   PetscInt :: ip1, ip2
  2120)   PetscInt :: local_id, ghosted_id, local_id_up, local_id_dn, ghosted_id_up, ghosted_id_dn
  2121) 
  2122)   PetscReal, pointer ::accum_p(:)
  2123) 
  2124)   PetscReal, pointer :: r_p(:), xx_loc_p(:), xx_p(:), yy_p(:)
  2125)                           
  2126)                
  2127)   PetscReal, pointer :: iphase_loc_p(:), icap_loc_p(:), ithrm_loc_p(:)
  2128) 
  2129)   PetscInt :: iphase
  2130)   PetscInt :: icap_up, icap_dn, ithrm_up, ithrm_dn
  2131)   PetscReal :: dd_up, dd_dn
  2132)   PetscReal :: dd, f_up, f_dn, ff
  2133)   PetscReal :: perm_up, perm_dn
  2134)   PetscReal :: D_up, D_dn  ! "Diffusion" constants at upstream, downstream faces.
  2135)   PetscReal :: dw_kg, dw_mol,dddt,dddp
  2136)   PetscReal :: tsrc1, qsrc1, csrc1, enth_src_h2o, enth_src_co2 , hsrc1
  2137)   PetscReal :: rho, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt, dvdp, xphi
  2138)   PetscReal :: upweight
  2139)   PetscReal :: Res(realization%option%nflowdof), v_darcy(realization%option%nphase)
  2140)   PetscReal :: xxbc(realization%option%nflowdof)
  2141)   PetscReal :: psrc(1:realization%option%nphase)
  2142)   PetscViewer :: viewer
  2143)   PetscInt :: nsrcpara
  2144)   PetscReal, pointer :: msrc(:)
  2145) 
  2146) 
  2147)   type(grid_type), pointer :: grid
  2148)   type(patch_type), pointer :: patch
  2149)   type(option_type), pointer :: option
  2150)   type(field_type), pointer :: field
  2151)   type(Flash2_parameter_type), pointer :: Flash2_parameter
  2152)   type(Flash2_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
  2153)   type(coupler_type), pointer :: boundary_condition, source_sink
  2154)   type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
  2155)   type(connection_set_list_type), pointer :: connection_set_list
  2156)   type(connection_set_type), pointer :: cur_connection_set
  2157)   class(material_auxvar_type), pointer :: material_auxvars(:)
  2158)   PetscBool :: enthalpy_flag
  2159)   PetscInt :: ng
  2160)   PetscInt :: iconn, idof, istart, iend
  2161)   PetscInt :: sum_connection
  2162)   PetscReal :: distance, fraction_upwind
  2163)   PetscReal :: distance_gravity
  2164)   PetscReal, pointer :: Resold_AR(:), Resold_FL(:), delx(:)
  2165)   PetscReal :: ss_flow_vol_flux(realization%option%nphase)
  2166)   character(len=MAXSTRINGLENGTH) :: string
  2167) 
  2168)   patch => realization%patch
  2169)   grid => patch%grid
  2170)   option => realization%option
  2171)   field => realization%field
  2172) 
  2173)   Flash2_parameter => patch%aux%Flash2%Flash2_parameter
  2174)   auxvars => patch%aux%Flash2%auxvars
  2175)   auxvars_bc => patch%aux%Flash2%auxvars_bc
  2176)   global_auxvars => patch%aux%Global%auxvars
  2177)   global_auxvars_bc => patch%aux%Global%auxvars_bc
  2178)   material_auxvars => patch%aux%Material%auxvars
  2179)   
  2180)  ! call Flash2UpdateAuxVarsPatchNinc(realization)
  2181)   ! override flags since they will soon be out of date  
  2182)  ! patch%Flash2Aux%auxvars_up_to_date = PETSC_FALSE 
  2183) 
  2184) ! now assign access pointer to local variables
  2185)   call VecGetArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
  2186)   call VecGetArrayF90(r, r_p, ierr);CHKERRQ(ierr)
  2187)   call VecGetArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
  2188)  
  2189)   call VecGetArrayF90(field%flow_yy,yy_p,ierr);CHKERRQ(ierr)
  2190)   call VecGetArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
  2191)   call VecGetArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
  2192) !  call VecGetArrayF90(field%iphas_loc, iphase_loc_p, ierr)
  2193)   allocate(Resold_AR(option%nflowdof), Resold_FL(option%nflowdof), delx(option%nflowdof))
  2194)  
  2195) ! Multiphase flash calculation is more expensive, so calculate once per iteration
  2196) #if 1
  2197)   ! Pertubations for aux terms --------------------------------
  2198)   do ng = 1, grid%ngmax
  2199)     if (grid%nG2L(ng) < 0)cycle
  2200)     if (associated(patch%imat)) then
  2201)         if (patch%imat(ng) <= 0) cycle
  2202)     endif
  2203)     ghosted_id = ng
  2204)     istart =  (ng-1) * option%nflowdof +1 ; iend = istart -1 + option%nflowdof
  2205)      ! iphase =int(iphase_loc_p(ng))
  2206)     call Flash2AuxVarCompute_Ninc(xx_loc_p(istart:iend),auxvars(ng)%auxvar_elem(0),&
  2207)           global_auxvars(ng),&
  2208)           patch%saturation_function_array(int(icap_loc_p(ng)))%ptr,&
  2209)           realization%fluid_properties,option, xphi)
  2210) !   print *,'flash ', xx_loc_p(istart:iend),auxvars(ng)%auxvar_elem(0)%den
  2211) #if 1
  2212)     if (associated(global_auxvars)) then
  2213)       global_auxvars(ghosted_id)%pres(:)= auxvars(ghosted_id)%auxvar_elem(0)%pres -&
  2214)                auxvars(ghosted_id)%auxvar_elem(0)%pc(:)
  2215)       global_auxvars(ghosted_id)%temp=auxvars(ghosted_id)%auxvar_elem(0)%temp
  2216)       global_auxvars(ghosted_id)%sat(:)=auxvars(ghosted_id)%auxvar_elem(0)%sat(:)
  2217) !     global_auxvars(ghosted_id)%sat_store =
  2218)       global_auxvars(ghosted_id)%fugacoeff(1)=xphi
  2219)       global_auxvars(ghosted_id)%den(:)=auxvars(ghosted_id)%auxvar_elem(0)%den(:)
  2220)       global_auxvars(ghosted_id)%den_kg(:) = auxvars(ghosted_id)%auxvar_elem(0)%den(:) &
  2221)                                           * auxvars(ghosted_id)%auxvar_elem(0)%avgmw(:)
  2222) !       global_auxvars(ghosted_id)%reaction_rate(:)=0D0
  2223) !      global_auxvars(ghosted_id)%pres(:)
  2224)     else
  2225)       print *,'Not associated global for Flash2'
  2226)     endif
  2227) #endif
  2228) 
  2229)     if (option%flow%numerical_derivatives) then
  2230)       delx(1) = xx_loc_p((ng-1)*option%nflowdof+1)*dfac * 1.D-3
  2231)       delx(2) = xx_loc_p((ng-1)*option%nflowdof+2)*dfac
  2232)  
  2233)       if (xx_loc_p((ng-1)*option%nflowdof+3) <= 0.9) then
  2234)         delx(3) = dfac*xx_loc_p((ng-1)*option%nflowdof+3)*1D1
  2235)       else
  2236)             delx(3) = -dfac*xx_loc_p((ng-1)*option%nflowdof+3)*1D1 
  2237)       endif
  2238)       if (delx(3) < 1D-8 .and. delx(3) >= 0.D0) delx(3) = 1D-8
  2239)       if (delx(3) >-1D-8 .and. delx(3) < 0.D0) delx(3) = -1D-8
  2240) 
  2241)            
  2242)       if ((delx(3)+xx_loc_p((ng-1)*option%nflowdof+3))>1.D0) then
  2243)         delx(3) = (1.D0-xx_loc_p((ng-1)*option%nflowdof+3))*1D-4
  2244)       endif
  2245)       if ((delx(3)+xx_loc_p((ng-1)*option%nflowdof+3))<0.D0) then
  2246)         delx(3) = xx_loc_p((ng-1)*option%nflowdof+3)*1D-4
  2247)       endif
  2248) 
  2249)       patch%aux%Flash2%delx(:,ng)=delx(:)
  2250)       call Flash2AuxVarCompute_Winc(xx_loc_p(istart:iend),delx(:),&
  2251)             auxvars(ng)%auxvar_elem(1:option%nflowdof),global_auxvars(ng),&
  2252)             patch%saturation_function_array(int(icap_loc_p(ng)))%ptr,&
  2253)             realization%fluid_properties,option)
  2254) !         if (auxvars(ng)%auxvar_elem(option%nflowdof)%sat(2)>1D-8 .and. &
  2255) !            auxvars(ng)%auxvar_elem(0)%sat(2)<1D-12)then
  2256) !            print *, 'Flash winc', delx(3,ng)
  2257) !         endif   
  2258)     endif
  2259)   enddo
  2260) #endif
  2261) 
  2262)   Resold_AR=0.D0; ResOld_FL=0.D0; r_p = 0.d0
  2263)   patch%aux%Flash2%Resold_AR=0.D0
  2264)   patch%aux%Flash2%Resold_BC=0.D0
  2265)   patch%aux%Flash2%ResOld_FL=0.D0
  2266)    
  2267) #if 1
  2268)   ! Accumulation terms ------------------------------------
  2269)   r_p = - accum_p
  2270) 
  2271)   do local_id = 1, grid%nlmax  ! For each local node do...
  2272)     ghosted_id = grid%nL2G(local_id)
  2273)     !geh - Ignore inactive cells with inactive materials
  2274)     if (associated(patch%imat)) then
  2275)       if (patch%imat(ghosted_id) <= 0) cycle
  2276)     endif
  2277)     iend = local_id*option%nflowdof
  2278)     istart = iend-option%nflowdof+1
  2279)     call Flash2Accumulation(auxvars(ghosted_id)%auxvar_elem(0),&
  2280)                             global_auxvars(ghosted_id), &
  2281)                             material_auxvars(ghosted_id)%porosity, &
  2282)                             material_auxvars(ghosted_id)%volume, &
  2283)                             Flash2_parameter%dencpr(int(ithrm_loc_p(ghosted_id))), &
  2284)                             option,ONE_INTEGER,Res) 
  2285)     r_p(istart:iend) = r_p(istart:iend) + Res(1:option%nflowdof)
  2286)     !print *,'REs, acm: ', res
  2287)     patch%aux%Flash2%Resold_AR(local_id, :)= Res(1:option%nflowdof)
  2288)   enddo
  2289) #endif
  2290) #if 1
  2291)   ! Source/sink terms -------------------------------------
  2292)   source_sink => patch%source_sink_list%first 
  2293)   sum_connection = 0 
  2294)   do 
  2295)     if (.not.associated(source_sink)) exit
  2296)     !print *, 'RES s/s begin'
  2297)     ! check whether enthalpy dof is included
  2298)   !  if (source_sink%flow_condition%num_sub_conditions > 3) then
  2299)       enthalpy_flag = PETSC_TRUE
  2300)    ! else
  2301)    !   enthalpy_flag = PETSC_FALSE
  2302)    ! endif
  2303)     if (associated(source_sink%flow_condition%pressure)) then
  2304)       psrc(:) = source_sink%flow_condition%pressure%dataset%rarray(:)
  2305)     endif
  2306) !    qsrc1 = source_sink%flow_condition%pressure%dataset%rarray(1)
  2307)     tsrc1 = source_sink%flow_condition%temperature%dataset%rarray(1)
  2308)     csrc1 = source_sink%flow_condition%concentration%dataset%rarray(1)
  2309)     if (enthalpy_flag) hsrc1 = source_sink%flow_condition%enthalpy%dataset%rarray(1)
  2310) !    hsrc1=0D0
  2311) !    qsrc1 = qsrc1 / FMWH2O ! [kg/s -> kmol/s; fmw -> g/mol = kg/kmol]
  2312) !    csrc1 = csrc1 / FMWCO2
  2313) !    msrc(1)=qsrc1; msrc(2) =csrc1
  2314) !    msrc(:)= psrc(:)
  2315) 
  2316)     select case(source_sink%flow_condition%itype(1))
  2317)       case(MASS_RATE_SS)
  2318)         msrc => source_sink%flow_condition%rate%dataset%rarray
  2319)         nsrcpara= 2
  2320)       case(WELL_SS)
  2321)         msrc => source_sink%flow_condition%well%dataset%rarray
  2322)         nsrcpara = 7 + option%nflowspec 
  2323)       case default
  2324)         print *, 'Flash mode does not support source/sink type: ', source_sink%flow_condition%itype(1)
  2325)         stop  
  2326)     end select
  2327) 
  2328)      cur_connection_set => source_sink%connection_set
  2329)     
  2330)     do iconn = 1, cur_connection_set%num_connections      
  2331)       local_id = cur_connection_set%id_dn(iconn)
  2332)       ghosted_id = grid%nL2G(local_id)
  2333)       if (associated(patch%imat)) then
  2334)         if (patch%imat(ghosted_id) <= 0) cycle
  2335)       endif
  2336)       call Flash2SourceSink(msrc,nsrcpara,psrc,tsrc1,hsrc1,csrc1,auxvars(ghosted_id)%auxvar_elem(0),&
  2337)                             source_sink%flow_condition%itype(1),Res, &
  2338)                             ss_flow_vol_flux, &
  2339)                             enthalpy_flag, option)
  2340)       if (associated(patch%ss_flow_fluxes)) then
  2341)         patch%ss_flow_fluxes(:,sum_connection) = Res(:)/option%flow_dt
  2342)       endif    
  2343)       if (associated(patch%ss_flow_vol_fluxes)) then
  2344)         patch%ss_flow_vol_fluxes(:,sum_connection) = ss_flow_vol_flux(:)/option%flow_dt
  2345)       endif    
  2346)       r_p((local_id-1)*option%nflowdof + jh2o) = r_p((local_id-1)*option%nflowdof + jh2o)-Res(jh2o)
  2347)       r_p((local_id-1)*option%nflowdof + jco2) = r_p((local_id-1)*option%nflowdof + jco2)-Res(jco2)
  2348)       patch%aux%Flash2%Resold_AR(local_id,jh2o)= patch%aux%Flash2%Resold_AR(local_id,jh2o) - Res(jh2o)    
  2349)       patch%aux%Flash2%Resold_AR(local_id,jco2)= patch%aux%Flash2%Resold_AR(local_id,jco2) - Res(jco2)    
  2350)       if (enthalpy_flag) then
  2351)         r_p( local_id*option%nflowdof) = r_p(local_id*option%nflowdof) - Res(option%nflowdof)
  2352)         patch%aux%Flash2%Resold_AR(local_id,option%nflowdof)=&
  2353)           patch%aux%Flash2%Resold_AR(local_id,option%nflowdof) - Res(option%nflowdof)
  2354)        endif 
  2355)   !  else if (qsrc1 < 0.d0) then ! withdrawal
  2356)   !  endif
  2357)     enddo
  2358)     source_sink => source_sink%next
  2359)   enddo
  2360) #endif
  2361) #if 1
  2362)   ! Boundary Flux Terms -----------------------------------
  2363)   boundary_condition => patch%boundary_condition_list%first
  2364)   sum_connection = 0    
  2365)   do 
  2366)     if (.not.associated(boundary_condition)) exit
  2367)     
  2368)     cur_connection_set => boundary_condition%connection_set
  2369)         
  2370)     do iconn = 1, cur_connection_set%num_connections
  2371)       sum_connection = sum_connection + 1
  2372)     
  2373)       local_id = cur_connection_set%id_dn(iconn)
  2374)       ghosted_id = grid%nL2G(local_id)
  2375) 
  2376)       if (associated(patch%imat)) then
  2377)         if (patch%imat(ghosted_id) <= 0) cycle
  2378)       endif
  2379) 
  2380)       if (ghosted_id<=0) then
  2381)         print *, "Wrong boundary node index... STOP!!!"
  2382)         stop
  2383)       endif
  2384) 
  2385)       ithrm_dn = int(ithrm_loc_p(ghosted_id))
  2386)       D_dn = Flash2_parameter%ckwet(ithrm_dn)
  2387) 
  2388)       ! for now, just assume diagonal tensor
  2389)       call material_auxvars(ghosted_id)%PermeabilityTensorToScalar( &
  2390)                             cur_connection_set%dist(:,iconn),perm_dn)
  2391)       ! dist(0,iconn) = scalar - magnitude of distance
  2392)       ! gravity = vector(3)
  2393)       ! dist(1:3,iconn) = vector(3) - unit vector
  2394)       distance_gravity = cur_connection_set%dist(0,iconn) * &
  2395)                          dot_product(option%gravity, &
  2396)                                      cur_connection_set%dist(1:3,iconn))
  2397) 
  2398)       icap_dn = int(icap_loc_p(ghosted_id))  
  2399) ! Then need fill up increments for BCs
  2400)       do idof =1, option%nflowdof
  2401)         select case(boundary_condition%flow_condition%itype(idof))
  2402)         case(DIRICHLET_BC)
  2403)           xxbc(idof) = boundary_condition%flow_aux_real_var(idof,iconn)
  2404)         case(HYDROSTATIC_BC)
  2405)           xxbc(1) = boundary_condition%flow_aux_real_var(1,iconn)
  2406)           if (idof >= 2) then
  2407)             xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
  2408)           endif
  2409)         case(NEUMANN_BC, ZERO_GRADIENT_BC)
  2410)           ! solve for pb from Darcy's law given qb /= 0
  2411)           xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
  2412) !          iphase = int(iphase_loc_p(ghosted_id))
  2413)         end select
  2414)       enddo
  2415) 
  2416)  
  2417)       call Flash2AuxVarCompute_Ninc(xxbc,auxvars_bc(sum_connection)%auxvar_elem(0),&
  2418)            global_auxvars_bc(sum_connection),&
  2419)            patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr,&
  2420)            realization%fluid_properties, option)
  2421) #if 1
  2422)       if (associated(global_auxvars_bc)) then
  2423)         global_auxvars_bc(sum_connection)%pres(:)= auxvars_bc(sum_connection)%auxvar_elem(0)%pres -&
  2424)                      auxvars(ghosted_id)%auxvar_elem(0)%pc(:)
  2425)         global_auxvars_bc(sum_connection)%temp=auxvars_bc(sum_connection)%auxvar_elem(0)%temp
  2426)         global_auxvars_bc(sum_connection)%sat(:)=auxvars_bc(sum_connection)%auxvar_elem(0)%sat(:)
  2427)         !    global_auxvars(ghosted_id)%sat_store =
  2428)         global_auxvars_bc(sum_connection)%fugacoeff(1)=xphi
  2429)         global_auxvars_bc(sum_connection)%den(:)=auxvars_bc(sum_connection)%auxvar_elem(0)%den(:)
  2430)         global_auxvars_bc(sum_connection)%den_kg = auxvars_bc(sum_connection)%auxvar_elem(0)%den(:) &
  2431)                                           * auxvars_bc(sum_connection)%auxvar_elem(0)%avgmw(:)
  2432)   !   global_auxvars(ghosted_id)%den_kg_store
  2433)       endif
  2434) #endif
  2435) 
  2436)       call Flash2BCFlux(boundary_condition%flow_condition%itype, &
  2437)          boundary_condition%flow_aux_real_var(:,iconn), &
  2438)          auxvars_bc(sum_connection)%auxvar_elem(0), &
  2439)          auxvars(ghosted_id)%auxvar_elem(0), &
  2440)          material_auxvars(ghosted_id)%porosity, &
  2441)          material_auxvars(ghosted_id)%tortuosity, &
  2442)          Flash2_parameter%sir(:,icap_dn), &
  2443)          cur_connection_set%dist(0,iconn),perm_dn,D_dn, &
  2444)          cur_connection_set%area(iconn), &
  2445)          distance_gravity,option, &
  2446)          v_darcy,Res)
  2447)       patch%boundary_velocities(:,sum_connection) = v_darcy(:)
  2448)       iend = local_id*option%nflowdof
  2449)       istart = iend-option%nflowdof+1
  2450)       r_p(istart:iend)= r_p(istart:iend) - Res(1:option%nflowdof)
  2451)       patch%aux%Flash2%Resold_AR(local_id,1:option%nflowdof) = &
  2452)       patch%aux%Flash2%ResOld_AR(local_id,1:option%nflowdof) - Res(1:option%nflowdof)
  2453)       if (associated(patch%boundary_flow_fluxes)) then
  2454)         patch%boundary_flow_fluxes(:,sum_connection) = Res(:)/option%flow_dt
  2455)       endif      
  2456)     enddo
  2457)     boundary_condition => boundary_condition%next
  2458)   enddo
  2459) #endif
  2460) #if 1
  2461)   ! Interior Flux Terms -----------------------------------
  2462)   connection_set_list => grid%internal_connection_set_list
  2463)   cur_connection_set => connection_set_list%first
  2464)   sum_connection = 0  
  2465)   do 
  2466)     if (.not.associated(cur_connection_set)) exit
  2467)     do iconn = 1, cur_connection_set%num_connections
  2468)       sum_connection = sum_connection + 1
  2469) 
  2470)       ghosted_id_up = cur_connection_set%id_up(iconn)
  2471)       ghosted_id_dn = cur_connection_set%id_dn(iconn)
  2472) 
  2473)       local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
  2474)       local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping   
  2475) 
  2476)       if (associated(patch%imat)) then
  2477)         if (patch%imat(ghosted_id_up) <= 0 .or.  &
  2478)             patch%imat(ghosted_id_dn) <= 0) cycle
  2479)       endif
  2480) 
  2481)       fraction_upwind = cur_connection_set%dist(-1,iconn)
  2482)       distance = cur_connection_set%dist(0,iconn)
  2483)       ! distance = scalar - magnitude of distance
  2484)       ! gravity = vector(3)
  2485)       ! dist(1:3,iconn) = vector(3) - unit vector
  2486)       distance_gravity = distance * &
  2487)                          dot_product(option%gravity, &
  2488)                                      cur_connection_set%dist(1:3,iconn))
  2489)       dd_up = distance*fraction_upwind
  2490)       dd_dn = distance-dd_up ! should avoid truncation error
  2491)       ! upweight could be calculated as 1.d0-fraction_upwind
  2492)       ! however, this introduces ever so slight error causing pflow-overhaul not
  2493)       ! to match pflow-orig.  This can be changed to 1.d0-fraction_upwind
  2494)       upweight = dd_dn/(dd_up+dd_dn)
  2495)         
  2496)       ! for now, just assume diagonal tensor
  2497)       call material_auxvars(ghosted_id_up)%PermeabilityTensorToScalar( &
  2498)                             cur_connection_set%dist(:,iconn),perm_up)
  2499)       call material_auxvars(ghosted_id_dn)%PermeabilityTensorToScalar( &
  2500)                             cur_connection_set%dist(:,iconn),perm_dn)
  2501) 
  2502)       ithrm_up = int(ithrm_loc_p(ghosted_id_up))
  2503)       ithrm_dn = int(ithrm_loc_p(ghosted_id_dn))
  2504)       icap_up = int(icap_loc_p(ghosted_id_up))
  2505)       icap_dn = int(icap_loc_p(ghosted_id_dn))
  2506)    
  2507)       D_up = Flash2_parameter%ckwet(ithrm_up)
  2508)       D_dn = Flash2_parameter%ckwet(ithrm_dn)
  2509) 
  2510)       call Flash2Flux(auxvars(ghosted_id_up)%auxvar_elem(0), &
  2511)                       material_auxvars(ghosted_id_up)%porosity, &
  2512)                       material_auxvars(ghosted_id_up)%tortuosity, &
  2513)                       Flash2_parameter%sir(:,icap_up), &
  2514)                       dd_up,perm_up,D_up, &
  2515)                       auxvars(ghosted_id_dn)%auxvar_elem(0), &
  2516)                       material_auxvars(ghosted_id_dn)%porosity, &
  2517)                       material_auxvars(ghosted_id_dn)%tortuosity, &
  2518)                       Flash2_parameter%sir(:,icap_dn), &
  2519)                       dd_dn,perm_dn,D_dn, &
  2520)                       cur_connection_set%area(iconn),distance_gravity, &
  2521)                       upweight,option,v_darcy,Res)
  2522) 
  2523)       patch%internal_velocities(:,sum_connection) = v_darcy(:)
  2524)       patch%aux%Flash2%Resold_FL(sum_connection,1:option%nflowdof)= Res(1:option%nflowdof)
  2525)  
  2526)      if (local_id_up > 0) then
  2527)         iend = local_id_up*option%nflowdof
  2528)         istart = iend-option%nflowdof+1
  2529)         r_p(istart:iend) = r_p(istart:iend) + Res(1:option%nflowdof)
  2530)       endif
  2531)    
  2532)       if (local_id_dn>0) then
  2533)         iend = local_id_dn*option%nflowdof
  2534)         istart = iend-option%nflowdof+1
  2535)         r_p(istart:iend) = r_p(istart:iend) - Res(1:option%nflowdof)
  2536)       endif
  2537) 
  2538)       if (associated(patch%internal_flow_fluxes)) then
  2539)         patch%internal_flow_fluxes(:,sum_connection) = Res(:)/option%flow_dt
  2540)       endif
  2541) 
  2542)     enddo
  2543)     cur_connection_set => cur_connection_set%next
  2544)   enddo    
  2545) #endif
  2546) 
  2547) ! adjust residual to R/dt
  2548)   select case (option%idt_switch) 
  2549)   case(1) 
  2550)      r_p(:) = r_p(:)/option%flow_dt
  2551)   case(-1)
  2552)      if (option%flow_dt>1.D0) r_p(:) = r_p(:)/option%flow_dt
  2553)   end select
  2554)   
  2555)   do local_id = 1, grid%nlmax
  2556)     if (associated(patch%imat)) then
  2557)       if (patch%imat(grid%nL2G(local_id)) <= 0) cycle
  2558)     endif
  2559)     ghosted_id = grid%nL2G(local_id)
  2560)     istart = 1 + (local_id-1)*option%nflowdof
  2561)     if (material_auxvars(ghosted_id)%volume>1.D0) then
  2562)       r_p (istart:istart+2)=r_p(istart:istart+2) / &
  2563)          material_auxvars(ghosted_id)%volume
  2564)     endif
  2565)     if (r_p(istart) >1E20 .or. r_p(istart) <-1E20) print *, r_p (istart:istart+2)
  2566) !     print *,'flash res', local_id, r_p (istart:istart+2)
  2567)   enddo
  2568) 
  2569) ! print *,'finished rp vol scale'
  2570)   if (option%use_isothermal) then
  2571)     do local_id = 1, grid%nlmax  ! For each local node do...
  2572)       ghosted_id = grid%nL2G(local_id)   ! corresponding ghost index
  2573)       if (associated(patch%imat)) then
  2574)         if (patch%imat(ghosted_id) <= 0) cycle
  2575)       endif
  2576)       istart = 3 + (local_id-1)*option%nflowdof
  2577)       r_p(istart) = 0.D0 ! xx_loc_p(2 + (ng-1)*option%nflowdof) - yy_p(p1-1)
  2578)     enddo
  2579)   endif
  2580) 
  2581) 
  2582)   if (patch%aux%Flash2%inactive_cells_exist) then
  2583)     do i=1,patch%aux%Flash2%n_zero_rows
  2584)       r_p(patch%aux%Flash2%zero_rows_local(i)) = 0.d0
  2585)     enddo
  2586)   endif
  2587) 
  2588)   call VecRestoreArrayF90(r, r_p, ierr);CHKERRQ(ierr)
  2589)   call VecRestoreArrayF90(field%flow_yy, yy_p, ierr);CHKERRQ(ierr)
  2590)   call VecRestoreArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
  2591)   call VecRestoreArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
  2592)   call VecRestoreArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
  2593)   call VecRestoreArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
  2594) !  call VecRestoreArrayF90(field%iphas_loc, iphase_loc_p, ierr)
  2595)   deallocate(Resold_AR, Resold_FL, delx)
  2596)   
  2597)   if (realization%debug%vecview_residual) then
  2598)     string = 'Fresidual'
  2599)     call DebugCreateViewer(realization%debug,string,option,viewer)
  2600)     call VecView(r,viewer,ierr);CHKERRQ(ierr)
  2601)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  2602)   endif
  2603)   if (realization%debug%vecview_solution) then
  2604)     string = 'Fxx'
  2605)     call DebugCreateViewer(realization%debug,string,option,viewer)
  2606)     call VecView(xx,viewer,ierr);CHKERRQ(ierr)
  2607)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  2608)   endif
  2609) end subroutine Flash2ResidualPatch
  2610) 
  2611) ! ************************************************************************** !
  2612) 
  2613) subroutine Flash2ResidualPatch1(snes,xx,r,realization,ierr)
  2614)   ! 
  2615)   ! Flash2Jacobian: Computes the Residual by Flux
  2616)   ! 
  2617)   ! Author: Chuan Lu
  2618)   ! Date: 10/10/08
  2619)   ! 
  2620) 
  2621)   use Connection_module
  2622)   use Realization_Subsurface_class
  2623)   use Patch_module
  2624)   use Grid_module
  2625)   use Option_module
  2626)   use Coupler_module  
  2627)   use Field_module
  2628)   use Debug_module
  2629)   use Material_Aux_class
  2630)   
  2631)   implicit none
  2632)   
  2633)   type :: flux_ptrs
  2634)     PetscReal, dimension(:), pointer :: flux_p 
  2635)   end type
  2636) 
  2637)   type (flux_ptrs), dimension(0:2) :: fluxes
  2638)   SNES, intent(in) :: snes
  2639)   Vec, intent(inout) :: xx
  2640)   Vec, intent(out) :: r
  2641)   type(realization_subsurface_type) :: realization
  2642) 
  2643)   PetscErrorCode :: ierr
  2644)   PetscInt :: i, jn
  2645)   PetscInt :: ip1, ip2
  2646)   PetscInt :: local_id, ghosted_id, local_id_up, local_id_dn, ghosted_id_up, ghosted_id_dn
  2647) 
  2648)   PetscReal, pointer ::accum_p(:)
  2649) 
  2650)   PetscReal, pointer :: r_p(:), xx_loc_p(:)
  2651)                
  2652)   PetscReal, pointer :: iphase_loc_p(:), icap_loc_p(:), ithrm_loc_p(:)
  2653) 
  2654)   PetscInt :: iphase
  2655)   PetscInt :: icap_up, icap_dn, ithrm_up, ithrm_dn
  2656)   PetscReal :: dd_up, dd_dn
  2657)   PetscReal :: dd, f_up, f_dn, ff
  2658)   PetscReal :: perm_up, perm_dn
  2659)   PetscReal :: D_up, D_dn  ! "Diffusion" constants at upstream, downstream faces.
  2660)   PetscReal :: dw_kg, dw_mol,dddt,dddp
  2661)   PetscReal :: tsrc1, qsrc1, csrc1, enth_src_h2o, enth_src_co2 , hsrc1
  2662)   PetscReal :: rho, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt, dvdp, xphi
  2663)   PetscReal :: upweight
  2664)   PetscReal :: Res(realization%option%nflowdof), v_darcy(realization%option%nphase)
  2665)   PetscReal :: xxbc(realization%option%nflowdof)
  2666)   PetscViewer :: viewer
  2667) 
  2668) 
  2669)   type(grid_type), pointer :: grid
  2670)   type(patch_type), pointer :: patch
  2671)   type(option_type), pointer :: option
  2672)   type(field_type), pointer :: field
  2673)   type(Flash2_parameter_type), pointer :: Flash2_parameter
  2674)   type(Flash2_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
  2675)   type(coupler_type), pointer :: boundary_condition, source_sink
  2676)   type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
  2677)   class(material_auxvar_type), pointer :: material_auxvars(:)
  2678)   type(connection_set_list_type), pointer :: connection_set_list
  2679)   type(connection_set_type), pointer :: cur_connection_set
  2680)   PetscBool :: enthalpy_flag
  2681)   PetscInt :: ng
  2682)   PetscInt :: axis, side, nlx, nly, nlz, ngx, ngxy, pstart, pend, flux_id
  2683)    PetscInt :: direction, max_x_conn, max_y_conn
  2684)   PetscInt :: iconn, idof, istart, iend
  2685)   PetscInt :: sum_connection
  2686)   PetscReal :: distance, fraction_upwind
  2687)   PetscReal :: distance_gravity
  2688)   
  2689)   patch => realization%patch
  2690)   grid => patch%grid
  2691)   option => realization%option
  2692)   field => realization%field
  2693) 
  2694)   Flash2_parameter => patch%aux%Flash2%Flash2_parameter
  2695)   auxvars => patch%aux%Flash2%auxvars
  2696)   auxvars_bc => patch%aux%Flash2%auxvars_bc
  2697)   global_auxvars => patch%aux%Global%auxvars
  2698)   global_auxvars_bc => patch%aux%Global%auxvars_bc
  2699)   material_auxvars => patch%aux%Material%auxvars
  2700)   
  2701)  ! call Flash2UpdateAuxVarsPatchNinc(realization)
  2702)   ! override flags since they will soon be out of date  
  2703)  ! patch%Flash2Aux%auxvars_up_to_date = PETSC_FALSE 
  2704) 
  2705) ! now assign access pointer to local variables
  2706)   call VecGetArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
  2707)   call VecGetArrayF90( r, r_p, ierr);CHKERRQ(ierr)
  2708)   call VecGetArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
  2709)   call VecGetArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
  2710) 
  2711)   r_p = 0.d0
  2712)  
  2713)   ! Boundary Flux Terms -----------------------------------
  2714)   boundary_condition => patch%boundary_condition_list%first
  2715)   sum_connection = 0    
  2716)   do 
  2717)     if (.not.associated(boundary_condition)) exit
  2718)     
  2719)     cur_connection_set => boundary_condition%connection_set
  2720)         
  2721)     do iconn = 1, cur_connection_set%num_connections
  2722)       sum_connection = sum_connection + 1
  2723)     
  2724)       local_id = cur_connection_set%id_dn(iconn)
  2725)       ghosted_id = grid%nL2G(local_id)
  2726) 
  2727)       if (associated(patch%imat)) then
  2728)         if (patch%imat(ghosted_id) <= 0) cycle
  2729)       endif
  2730) 
  2731)       if (ghosted_id<=0) then
  2732)         print *, "Wrong boundary node index... STOP!!!"
  2733)         stop
  2734)       endif
  2735) 
  2736)       ithrm_dn = int(ithrm_loc_p(ghosted_id))
  2737)       D_dn = Flash2_parameter%ckwet(ithrm_dn)
  2738) 
  2739)       ! for now, just assume diagonal tensor
  2740)       call material_auxvars(ghosted_id)%PermeabilityTensorToScalar( &
  2741)                             cur_connection_set%dist(:,iconn),perm_dn)
  2742)       ! dist(0,iconn) = scalar - magnitude of distance
  2743)       ! gravity = vector(3)
  2744)       ! dist(1:3,iconn) = vector(3) - unit vector
  2745)       distance_gravity = cur_connection_set%dist(0,iconn) * &
  2746)                          dot_product(option%gravity, &
  2747)                                      cur_connection_set%dist(1:3,iconn))
  2748) 
  2749)       icap_dn = int(icap_loc_p(ghosted_id))  
  2750) ! Then need fill up increments for BCs
  2751)       do idof = 1, option%nflowdof
  2752)         select case(boundary_condition%flow_condition%itype(idof))
  2753)         case(DIRICHLET_BC)
  2754)           xxbc(idof) = boundary_condition%flow_aux_real_var(idof,iconn)
  2755)         case(HYDROSTATIC_BC)
  2756)           xxbc(1) = boundary_condition%flow_aux_real_var(1,iconn)
  2757)           if (idof >= 2) then
  2758)             xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
  2759)           endif
  2760)         case(NEUMANN_BC, ZERO_GRADIENT_BC)
  2761)           ! solve for pb from Darcy's law given qb /= 0
  2762)           xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
  2763) !          iphase = int(iphase_loc_p(ghosted_id))
  2764)         end select
  2765)       enddo
  2766) 
  2767)  
  2768)       call Flash2AuxVarCompute_Ninc(xxbc,auxvars_bc(sum_connection)%auxvar_elem(0),&
  2769)            global_auxvars_bc(sum_connection),&
  2770)            patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr,&
  2771)            realization%fluid_properties, option,xphi)
  2772) 
  2773)       if (associated(global_auxvars_bc)) then
  2774)         global_auxvars_bc(sum_connection)%pres(:)= auxvars_bc(sum_connection)%auxvar_elem(0)%pres -&
  2775)                      auxvars(ghosted_id)%auxvar_elem(0)%pc(:)
  2776)         global_auxvars_bc(sum_connection)%temp=auxvars_bc(sum_connection)%auxvar_elem(0)%temp
  2777)         global_auxvars_bc(sum_connection)%sat(:)=auxvars_bc(sum_connection)%auxvar_elem(0)%sat(:)
  2778)       !    global_auxvars(ghosted_id)%sat_store = 
  2779)         global_auxvars_bc(sum_connection)%fugacoeff(1)=xphi
  2780)         global_auxvars_bc(sum_connection)%den(:)=auxvars_bc(sum_connection)%auxvar_elem(0)%den(:)
  2781)         global_auxvars_bc(sum_connection)%den_kg = auxvars_bc(sum_connection)%auxvar_elem(0)%den(:) &
  2782)                                           * auxvars_bc(sum_connection)%auxvar_elem(0)%avgmw(:)
  2783)   !   global_auxvars(ghosted_id)%den_kg_store
  2784)       endif
  2785) 
  2786)       call Flash2BCFlux(boundary_condition%flow_condition%itype, &
  2787)          boundary_condition%flow_aux_real_var(:,iconn), &
  2788)          auxvars_bc(sum_connection)%auxvar_elem(0), &
  2789)          auxvars(ghosted_id)%auxvar_elem(0), &
  2790)          material_auxvars(ghosted_id)%porosity, &
  2791)          material_auxvars(ghosted_id)%tortuosity, &
  2792)          Flash2_parameter%sir(:,icap_dn), &
  2793)          cur_connection_set%dist(0,iconn),perm_dn,D_dn, &
  2794)          cur_connection_set%area(iconn), &
  2795)          distance_gravity,option, &
  2796)          v_darcy,Res)
  2797)       patch%boundary_velocities(:,sum_connection) = v_darcy(:)
  2798)       patch%aux%Flash2%Resold_BC(local_id,1:option%nflowdof) = &
  2799)       patch%aux%Flash2%ResOld_BC(local_id,1:option%nflowdof) - Res(1:option%nflowdof)
  2800) 
  2801)       iend = local_id*option%nflowdof
  2802)       istart = iend-option%nflowdof+1
  2803)       r_p(istart:iend)= r_p(istart:iend) - Res(1:option%nflowdof)
  2804)     enddo
  2805)     boundary_condition => boundary_condition%next
  2806)   enddo
  2807) 
  2808) #if 1
  2809) 
  2810)   ! Interior Flux Terms -----------------------------------
  2811)   connection_set_list => grid%internal_connection_set_list
  2812)   cur_connection_set => connection_set_list%first
  2813)   sum_connection = 0  
  2814)   do 
  2815)     if (.not.associated(cur_connection_set)) exit
  2816)     do iconn = 1, cur_connection_set%num_connections
  2817)       sum_connection = sum_connection + 1
  2818) 
  2819)       ghosted_id_up = cur_connection_set%id_up(iconn)
  2820)       ghosted_id_dn = cur_connection_set%id_dn(iconn)
  2821) 
  2822)       local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
  2823)       local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping   
  2824) 
  2825)       if (associated(patch%imat)) then
  2826)         if (patch%imat(ghosted_id_up) <= 0 .or.  &
  2827)             patch%imat(ghosted_id_dn) <= 0) cycle
  2828)       endif
  2829) 
  2830)       fraction_upwind = cur_connection_set%dist(-1,iconn)
  2831)       distance = cur_connection_set%dist(0,iconn)
  2832)       ! distance = scalar - magnitude of distance
  2833)       ! gravity = vector(3)
  2834)       ! dist(1:3,iconn) = vector(3) - unit vector
  2835)       distance_gravity = distance * &
  2836)                          dot_product(option%gravity, &
  2837)                                      cur_connection_set%dist(1:3,iconn))
  2838)       dd_up = distance*fraction_upwind
  2839)       dd_dn = distance-dd_up ! should avoid truncation error
  2840)       ! upweight could be calculated as 1.d0-fraction_upwind
  2841)       ! however, this introduces ever so slight error causing pflow-overhaul not
  2842)       ! to match pflow-orig.  This can be changed to 1.d0-fraction_upwind
  2843)       upweight = dd_dn/(dd_up+dd_dn)
  2844)         
  2845)       ! for now, just assume diagonal tensor
  2846)       call material_auxvars(ghosted_id_up)%PermeabilityTensorToScalar( &
  2847)                             cur_connection_set%dist(:,iconn),perm_up)
  2848)       call material_auxvars(ghosted_id_dn)%PermeabilityTensorToScalar( &
  2849)                             cur_connection_set%dist(:,iconn),perm_dn)
  2850) 
  2851)       ithrm_up = int(ithrm_loc_p(ghosted_id_up))
  2852)       ithrm_dn = int(ithrm_loc_p(ghosted_id_dn))
  2853)       icap_up = int(icap_loc_p(ghosted_id_up))
  2854)       icap_dn = int(icap_loc_p(ghosted_id_dn))
  2855)    
  2856)       D_up = Flash2_parameter%ckwet(ithrm_up)
  2857)       D_dn = Flash2_parameter%ckwet(ithrm_dn)
  2858) 
  2859)       call Flash2Flux(auxvars(ghosted_id_up)%auxvar_elem(0), &
  2860)                       material_auxvars(ghosted_id_up)%porosity, &
  2861)                       material_auxvars(ghosted_id_up)%tortuosity, &
  2862)                       Flash2_parameter%sir(:,icap_up), &
  2863)                       dd_up,perm_up,D_up, &
  2864)                       auxvars(ghosted_id_dn)%auxvar_elem(0), &
  2865)                       material_auxvars(ghosted_id_dn)%porosity, &
  2866)                       material_auxvars(ghosted_id_dn)%tortuosity, &
  2867)                       Flash2_parameter%sir(:,icap_dn), &
  2868)                       dd_dn,perm_dn,D_dn, &
  2869)                       cur_connection_set%area(iconn),distance_gravity, &
  2870)                       upweight,option,v_darcy,Res)
  2871) 
  2872)       patch%internal_velocities(:,sum_connection) = v_darcy(:)
  2873)       patch%aux%Flash2%Resold_FL(sum_connection,1:option%nflowdof)= Res(1:option%nflowdof)
  2874) 
  2875)       if (local_id_up>0) then
  2876)         iend = local_id_up*option%nflowdof
  2877)         istart = iend-option%nflowdof+1
  2878)         r_p(istart:iend) = r_p(istart:iend) + Res(1:option%nflowdof)
  2879)       endif
  2880)    
  2881)       if (local_id_dn>0) then
  2882)         iend = local_id_dn*option%nflowdof
  2883)         istart = iend-option%nflowdof+1
  2884)         r_p(istart:iend) = r_p(istart:iend) - Res(1:option%nflowdof)
  2885)       endif
  2886)     enddo
  2887)     cur_connection_set => cur_connection_set%next
  2888)   enddo    
  2889) #endif
  2890) 
  2891)   call VecRestoreArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
  2892)   call VecRestoreArrayF90( r, r_p, ierr);CHKERRQ(ierr)
  2893)   call VecRestoreArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
  2894)   call VecRestoreArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
  2895) 
  2896) end subroutine Flash2ResidualPatch1
  2897) 
  2898) ! ************************************************************************** !
  2899) 
  2900) subroutine Flash2ResidualPatch0(snes,xx,r,realization,ierr)
  2901)   ! 
  2902)   ! Flash2Jacobian: Computes the Residual Aux vars for numerical Jacobin
  2903)   ! 
  2904)   ! Author: Chuan Lu
  2905)   ! Date: 10/10/08
  2906)   ! 
  2907) 
  2908)   use Connection_module
  2909)   use Realization_Subsurface_class
  2910)   use Patch_module
  2911)   use Grid_module
  2912)   use Option_module
  2913)   use Coupler_module  
  2914)   use Field_module
  2915)   use Debug_module
  2916)   
  2917)   implicit none
  2918) 
  2919)   SNES, intent(in) :: snes
  2920)   Vec, intent(inout) :: xx
  2921)   Vec, intent(out) :: r
  2922)   type(realization_subsurface_type) :: realization
  2923) 
  2924)   PetscErrorCode :: ierr
  2925)   PetscInt :: i, jn
  2926)   PetscInt :: ip1, ip2
  2927)   PetscInt :: local_id, ghosted_id, local_id_up, local_id_dn, ghosted_id_up, ghosted_id_dn
  2928) 
  2929)   PetscReal, pointer ::accum_p(:)
  2930) 
  2931)   PetscReal, pointer :: r_p(:), xx_loc_p(:), xx_p(:), yy_p(:)
  2932)   PetscReal, pointer :: iphase_loc_p(:), icap_loc_p(:)
  2933) 
  2934)   PetscReal :: dw_kg, dw_mol,dddt,dddp
  2935)   PetscReal :: rho, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt, dvdp, xphi
  2936)   PetscReal :: upweight
  2937)   PetscReal :: Res(realization%option%nflowdof)
  2938) 
  2939) 
  2940)   type(grid_type), pointer :: grid
  2941)   type(patch_type), pointer :: patch
  2942)   type(option_type), pointer :: option
  2943)   type(field_type), pointer :: field
  2944)   type(Flash2_parameter_type), pointer :: Flash2_parameter
  2945)   type(Flash2_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
  2946)   type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
  2947)   PetscBool :: enthalpy_flag
  2948)   PetscInt :: ng
  2949)   PetscInt :: iconn, idof, istart, iend
  2950)   PetscReal, pointer :: delx(:)
  2951)   
  2952)   
  2953)   patch => realization%patch
  2954)   grid => patch%grid
  2955)   option => realization%option
  2956)   field => realization%field
  2957) 
  2958)   Flash2_parameter => patch%aux%Flash2%Flash2_parameter
  2959)   auxvars => patch%aux%Flash2%auxvars
  2960)   auxvars_bc => patch%aux%Flash2%auxvars_bc
  2961)   global_auxvars => patch%aux%Global%auxvars
  2962)   global_auxvars_bc => patch%aux%Global%auxvars_bc
  2963) 
  2964)  ! call Flash2UpdateAuxVarsPatchNinc(realization)
  2965)   ! override flags since they will soon be out of date  
  2966)  ! patch%Flash2Aux%auxvars_up_to_date = PETSC_FALSE 
  2967)  
  2968)   if (option%compute_mass_balance_new) then
  2969)     call Flash2ZeroMassBalDeltaPatch(realization)
  2970)   endif
  2971) 
  2972) ! now assign access pointer to local variables
  2973)   call VecGetArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
  2974)   call VecGetArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
  2975) 
  2976)   allocate(delx(option%nflowdof))
  2977) 
  2978)   patch%aux%Flash2%Resold_AR=0.D0
  2979)   patch%aux%Flash2%Resold_BC=0.D0
  2980)   patch%aux%Flash2%ResOld_FL=0.D0
  2981) 
  2982) ! Multiphase flash calculation is more expensive, so calculate once per iteration
  2983) #if 1
  2984)   ! Pertubations for aux terms --------------------------------
  2985)   do ng = 1, grid%ngmax
  2986)     if (grid%nG2L(ng)<0)cycle
  2987)     if (associated(patch%imat)) then
  2988)       if (patch%imat(ng) <= 0) cycle
  2989)     endif
  2990)     ghosted_id = ng   
  2991)     istart =  (ng-1) * option%nflowdof +1 ; iend = istart -1 + option%nflowdof
  2992)      ! iphase =int(iphase_loc_p(ng))
  2993)     call Flash2AuxVarCompute_Ninc(xx_loc_p(istart:iend),auxvars(ng)%auxvar_elem(0),&
  2994)           global_auxvars(ng),&
  2995)           patch%saturation_function_array(int(icap_loc_p(ng)))%ptr,&
  2996)           realization%fluid_properties,option, xphi)
  2997) !    print *,'flash ', xx_loc_p(istart:iend),auxvars(ng)%auxvar_elem(0)%den
  2998) #if 1
  2999)     if (associated(global_auxvars)) then
  3000)       global_auxvars(ghosted_id)%pres(:)= auxvars(ghosted_id)%auxvar_elem(0)%pres -&
  3001)                auxvars(ghosted_id)%auxvar_elem(0)%pc(:)
  3002)       global_auxvars(ghosted_id)%temp=auxvars(ghosted_id)%auxvar_elem(0)%temp
  3003)       global_auxvars(ghosted_id)%sat(:)=auxvars(ghosted_id)%auxvar_elem(0)%sat(:)
  3004) !      global_auxvars(ghosted_id)%sat_store =
  3005)       global_auxvars(ghosted_id)%fugacoeff(1)=xphi
  3006)       global_auxvars(ghosted_id)%den(:)=auxvars(ghosted_id)%auxvar_elem(0)%den(:)
  3007)       global_auxvars(ghosted_id)%den_kg(:) = auxvars(ghosted_id)%auxvar_elem(0)%den(:) &
  3008)                                           * auxvars(ghosted_id)%auxvar_elem(0)%avgmw(:)
  3009) !       global_auxvars(ghosted_id)%reaction_rate(:)=0D0
  3010) !      global_auxvars(ghosted_id)%pres(:)
  3011)     else
  3012)       print *,'Not associated global for Flash2'
  3013)     endif
  3014) #endif
  3015) 
  3016)     if (option%flow%numerical_derivatives) then
  3017)       delx(1) = xx_loc_p((ng-1)*option%nflowdof+1)*dfac * 1.D-3
  3018)       delx(2) = xx_loc_p((ng-1)*option%nflowdof+2)*dfac
  3019)  
  3020)       if (xx_loc_p((ng-1)*option%nflowdof+3) <=0.9) then
  3021)         delx(3) = dfac*xx_loc_p((ng-1)*option%nflowdof+3)*1D1 
  3022)       else
  3023)         delx(3) = -dfac*xx_loc_p((ng-1)*option%nflowdof+3)*1D1 
  3024)       endif
  3025)       if (delx(3) < 1D-8 .and.  delx(3)>=0.D0) delx(3) = 1D-8
  3026)       if (delx(3) >-1D-8 .and.  delx(3)<0.D0) delx(3) =-1D-8
  3027) 
  3028)            
  3029)       if ((delx(3)+xx_loc_p((ng-1)*option%nflowdof+3))>1.D0) then
  3030)             delx(3) = (1.D0-xx_loc_p((ng-1)*option%nflowdof+3))*1D-4
  3031)       endif
  3032)       if ((delx(3)+xx_loc_p((ng-1)*option%nflowdof+3))<0.D0) then
  3033)             delx(3) = xx_loc_p((ng-1)*option%nflowdof+3)*1D-4
  3034)       endif
  3035) 
  3036)       patch%aux%Flash2%delx(:,ng)=delx(:)
  3037)       call Flash2AuxVarCompute_Winc(xx_loc_p(istart:iend),delx(:),&
  3038)             auxvars(ng)%auxvar_elem(1:option%nflowdof),global_auxvars(ng),&
  3039)             patch%saturation_function_array(int(icap_loc_p(ng)))%ptr,&
  3040)             realization%fluid_properties,option)
  3041) !         if (auxvars(ng)%auxvar_elem(option%nflowdof)%sat(2)>1D-8 .and. &
  3042) !            auxvars(ng)%auxvar_elem(0)%sat(2)<1D-12)then
  3043) !            print *, 'Flash winc', delx(3,ng)
  3044) !         endif   
  3045)     endif
  3046)   enddo
  3047) #endif
  3048)   deallocate(delx)
  3049)   call VecRestoreArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
  3050)   call VecRestoreArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
  3051) 
  3052) end subroutine Flash2ResidualPatch0
  3053) 
  3054) ! ************************************************************************** !
  3055) 
  3056) subroutine Flash2ResidualPatch2(snes,xx,r,realization,ierr)
  3057)   ! 
  3058)   ! Computes other terms in Residual
  3059)   ! (accumulation, source/sink, reaction)
  3060)   ! 
  3061)   ! Author: Chuan Lu
  3062)   ! Date: 10/10/08
  3063)   ! 
  3064) 
  3065)   use Connection_module
  3066)   use Realization_Subsurface_class
  3067)   use Patch_module
  3068)   use Grid_module
  3069)   use Option_module
  3070)   use Coupler_module  
  3071)   use Field_module
  3072)   use Debug_module
  3073)   use Material_Aux_class
  3074)   
  3075)   implicit none
  3076) 
  3077)   SNES, intent(in) :: snes
  3078)   Vec, intent(inout) :: xx
  3079)   Vec, intent(out) :: r
  3080)   type(realization_subsurface_type) :: realization
  3081) 
  3082)   PetscErrorCode :: ierr
  3083)   PetscInt :: i, jn
  3084)   PetscInt :: ip1, ip2
  3085)   PetscInt :: local_id, ghosted_id
  3086)   
  3087)   PetscReal, pointer ::accum_p(:)
  3088) 
  3089)   PetscReal, pointer :: r_p(:)
  3090)                
  3091)   PetscReal, pointer :: ithrm_loc_p(:)
  3092) 
  3093)   PetscReal :: dw_kg, dw_mol,dddt,dddp
  3094)   PetscReal :: tsrc1, qsrc1, csrc1, enth_src_h2o, enth_src_co2 , hsrc1
  3095)   PetscReal :: rho, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt, dvdp, xphi
  3096)   PetscReal :: Res(realization%option%nflowdof), v_darcy(realization%option%nphase)
  3097)   PetscReal :: xxbc(realization%option%nflowdof)
  3098)   PetscReal :: psrc(1:realization%option%nphase)
  3099)   PetscViewer :: viewer
  3100)   PetscInt :: nsrcpara
  3101)   PetscReal, pointer :: msrc(:)
  3102) 
  3103)   type(grid_type), pointer :: grid
  3104)   type(patch_type), pointer :: patch
  3105)   type(option_type), pointer :: option
  3106)   type(field_type), pointer :: field
  3107)   type(Flash2_parameter_type), pointer :: Flash2_parameter
  3108)   type(Flash2_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
  3109)   type(coupler_type), pointer :: boundary_condition, source_sink
  3110)   type(global_auxvar_type), pointer :: global_auxvars(:)
  3111)   type(global_auxvar_type), pointer :: global_auxvars_bc(:)
  3112)   type(global_auxvar_type), pointer :: global_auxvars_ss(:)
  3113)   class(material_auxvar_type), pointer :: material_auxvars(:)
  3114)   type(connection_set_list_type), pointer :: connection_set_list
  3115)   type(connection_set_type), pointer :: cur_connection_set
  3116)   PetscBool :: enthalpy_flag
  3117)   PetscInt :: ng
  3118)   PetscInt :: iconn, idof, istart, iend
  3119)   PetscInt :: sum_connection
  3120)   PetscReal :: distance, fraction_upwind
  3121)   PetscReal :: distance_gravity
  3122)   PetscReal :: ss_flow_vol_flux(realization%option%nphase)
  3123)   
  3124)   patch => realization%patch
  3125)   grid => patch%grid
  3126)   option => realization%option
  3127)   field => realization%field
  3128) 
  3129)   Flash2_parameter => patch%aux%Flash2%Flash2_parameter
  3130)   auxvars => patch%aux%Flash2%auxvars
  3131)   auxvars_bc => patch%aux%Flash2%auxvars_bc
  3132)   global_auxvars => patch%aux%Global%auxvars
  3133)   global_auxvars_bc => patch%aux%Global%auxvars_bc
  3134)   global_auxvars_ss => patch%aux%Global%auxvars_ss
  3135)   material_auxvars => patch%aux%Material%auxvars
  3136)   
  3137)  ! call Flash2UpdateAuxVarsPatchNinc(realization)
  3138)   ! override flags since they will soon be out of date  
  3139)  ! patch%Flash2Aux%auxvars_up_to_date = PETSC_FALSE 
  3140) 
  3141) ! now assign access pointer to local variables
  3142)   call VecGetArrayF90(r, r_p, ierr);CHKERRQ(ierr)
  3143)   call VecGetArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
  3144)   call VecGetArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
  3145)  
  3146)   ! Accumulation terms (include reaction------------------------------------
  3147)   if (.not.option%steady_state) then
  3148) #if 1
  3149)     r_p = r_p - accum_p
  3150) 
  3151)     do local_id = 1, grid%nlmax  ! For each local node do...
  3152)       ghosted_id = grid%nL2G(local_id)
  3153)       !geh - Ignore inactive cells with inactive materials
  3154)       if (associated(patch%imat)) then
  3155)         if (patch%imat(ghosted_id) <= 0) cycle
  3156)       endif
  3157)       iend = local_id*option%nflowdof
  3158)       istart = iend-option%nflowdof+1
  3159)       call Flash2Accumulation(auxvars(ghosted_id)%auxvar_elem(0),&
  3160)                             global_auxvars(ghosted_id), &
  3161)                             material_auxvars(ghosted_id)%porosity, &
  3162)                             material_auxvars(ghosted_id)%volume, &
  3163)                             Flash2_parameter%dencpr(int(ithrm_loc_p(ghosted_id))), &
  3164)                             option,ONE_INTEGER,Res) 
  3165)       r_p(istart:iend) = r_p(istart:iend) + Res(1:option%nflowdof)
  3166)     !print *,'REs, acm: ', res
  3167)       patch%aux%Flash2%Resold_AR(local_id, :)= &
  3168)       patch%aux%Flash2%Resold_AR(local_id, :)+ Res(1:option%nflowdof)
  3169)     enddo
  3170) #endif
  3171)   endif
  3172) 
  3173) #if 1
  3174)   ! Source/sink terms -------------------------------------
  3175)   source_sink => patch%source_sink_list%first
  3176)   sum_connection = 0 
  3177)   do 
  3178)     if (.not.associated(source_sink)) exit
  3179)     !print *, 'RES s/s begin'
  3180)     ! check whether enthalpy dof is included
  3181)   !  if (source_sink%flow_condition%num_sub_conditions > 3) then
  3182)       enthalpy_flag = PETSC_TRUE
  3183)    ! else
  3184)    !   enthalpy_flag = PETSC_FALSE
  3185)    ! endif
  3186)       
  3187)     if (associated(source_sink%flow_condition%pressure)) then
  3188)       psrc(:) = source_sink%flow_condition%pressure%dataset%rarray(:)
  3189)     endif 
  3190) !    qsrc1 = source_sink%flow_condition%pressure%dataset%rarray(1)
  3191)     tsrc1 = source_sink%flow_condition%temperature%dataset%rarray(1)
  3192)     csrc1 = source_sink%flow_condition%concentration%dataset%rarray(1)
  3193)     if (enthalpy_flag) hsrc1 = source_sink%flow_condition%enthalpy%dataset%rarray(1)
  3194) !    hsrc1=0D0
  3195) !    qsrc1 = qsrc1 / FMWH2O ! [kg/s -> kmol/s; fmw -> g/mol = kg/kmol]
  3196) !    csrc1 = csrc1 / FMWCO2
  3197) !    msrc(1)=qsrc1; msrc(2) =csrc1
  3198)     select case(source_sink%flow_condition%itype(1))
  3199)       case(MASS_RATE_SS)
  3200)         msrc => source_sink%flow_condition%rate%dataset%rarray
  3201)         nsrcpara= 2
  3202)       case(WELL_SS)
  3203)         msrc => source_sink%flow_condition%well%dataset%rarray
  3204)         nsrcpara = 7 + option%nflowspec 
  3205)       case default
  3206)         print *, 'Flash mode does not support source/sink type: ', source_sink%flow_condition%itype(1)
  3207)         stop  
  3208)     end select
  3209) 
  3210)     cur_connection_set => source_sink%connection_set
  3211)        
  3212)     do iconn = 1, cur_connection_set%num_connections      
  3213)       sum_connection = sum_connection + 1 
  3214)       local_id = cur_connection_set%id_dn(iconn)
  3215)       ghosted_id = grid%nL2G(local_id)
  3216)       if (associated(patch%imat)) then
  3217)         if (patch%imat(ghosted_id) <= 0) cycle
  3218)       endif
  3219)       
  3220)       call Flash2SourceSink(msrc,nsrcpara, psrc,tsrc1,hsrc1,csrc1,auxvars(ghosted_id)%auxvar_elem(0),&
  3221)                             source_sink%flow_condition%itype(1),Res, &
  3222)                             ss_flow_vol_flux, &
  3223)                             enthalpy_flag, option)
  3224)       if (option%compute_mass_balance_new) then
  3225)         global_auxvars_ss(sum_connection)%mass_balance_delta(:,1) = &
  3226)           global_auxvars_ss(sum_connection)%mass_balance_delta(:,1) - &
  3227)           Res(:)/option%flow_dt
  3228)       endif
  3229)       if (associated(patch%ss_flow_fluxes)) then
  3230)         patch%ss_flow_fluxes(:,sum_connection) = Res/option%flow_dt
  3231)       endif
  3232)       if (associated(patch%ss_flow_vol_fluxes)) then
  3233)         patch%ss_flow_vol_fluxes(:,sum_connection) = ss_flow_vol_flux/option%flow_dt
  3234)       endif
  3235)       r_p((local_id-1)*option%nflowdof + jh2o) = r_p((local_id-1)*option%nflowdof + jh2o)-Res(jh2o)
  3236)       r_p((local_id-1)*option%nflowdof + jco2) = r_p((local_id-1)*option%nflowdof + jco2)-Res(jco2)
  3237)       patch%aux%Flash2%Resold_AR(local_id,jh2o)= patch%aux%Flash2%Resold_AR(local_id,jh2o) - Res(jh2o)    
  3238)       patch%aux%Flash2%Resold_AR(local_id,jco2)= patch%aux%Flash2%Resold_AR(local_id,jco2) - Res(jco2)    
  3239)       if (enthalpy_flag)then
  3240)         r_p( local_id*option%nflowdof) = r_p(local_id*option%nflowdof) - Res(option%nflowdof)
  3241)         patch%aux%Flash2%Resold_AR(local_id,option%nflowdof)=&
  3242)           patch%aux%Flash2%Resold_AR(local_id,option%nflowdof) - Res(option%nflowdof)
  3243)        endif 
  3244)   !  else if (qsrc1 < 0.d0) then ! withdrawal
  3245)   !  endif
  3246)     enddo
  3247)     source_sink => source_sink%next
  3248)   enddo
  3249) #endif
  3250)   
  3251)   
  3252) ! adjust residual to R/dt
  3253)   select case (option%idt_switch) 
  3254)   case(1) 
  3255)      r_p(:) = r_p(:)/option%flow_dt
  3256)   case(-1)
  3257)      if (option%flow_dt>1.D0) r_p(:) = r_p(:)/option%flow_dt
  3258)   end select
  3259)   
  3260)   do local_id = 1, grid%nlmax
  3261)      if (associated(patch%imat)) then
  3262)         if (patch%imat(grid%nL2G(local_id)) <= 0) cycle
  3263)      endif
  3264)      ghosted_id = grid%nL2G(local_id)
  3265)      istart = 1 + (local_id-1)*option%nflowdof
  3266)      if (material_auxvars(ghosted_id)%volume>1.D0) then
  3267)        r_p (istart:istart+2)=r_p(istart:istart+2) / &
  3268)        material_auxvars(ghosted_id)%volume
  3269)      endif
  3270)      if (r_p(istart) >1E20 .or. r_p(istart) <-1E20) print *, r_p (istart:istart+2)
  3271) !     print *,'flash res', local_id, r_p (istart:istart+2)
  3272)   enddo
  3273) 
  3274) ! print *,'finished rp vol scale'
  3275)   if (option%use_isothermal) then
  3276)      do local_id = 1, grid%nlmax  ! For each local node do...
  3277)         ghosted_id = grid%nL2G(local_id)   ! corresponding ghost index
  3278)         if (associated(patch%imat)) then
  3279)            if (patch%imat(ghosted_id) <= 0) cycle
  3280)         endif
  3281)         istart = 3 + (local_id-1)*option%nflowdof
  3282)         r_p(istart) = 0.D0 ! xx_loc_p(2 + (ng-1)*option%nflowdof) - yy_p(p1-1)
  3283)      enddo
  3284)   endif
  3285)  
  3286)   if (patch%aux%Flash2%inactive_cells_exist) then
  3287)     do i=1,patch%aux%Flash2%n_zero_rows
  3288)       r_p(patch%aux%Flash2%zero_rows_local(i)) = 0.d0
  3289)     enddo
  3290)   endif
  3291)  
  3292)   call VecRestoreArrayF90(r, r_p, ierr);CHKERRQ(ierr)
  3293)   call VecRestoreArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
  3294)   call VecRestoreArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
  3295)  
  3296) end subroutine Flash2ResidualPatch2
  3297) 
  3298) ! ************************************************************************** !
  3299) 
  3300) subroutine Flash2Jacobian(snes,xx,A,B,realization,ierr)
  3301)   ! 
  3302)   ! Computes the Jacobian
  3303)   ! 
  3304)   ! Author: Chuan Lu
  3305)   ! Date: 10/10/08
  3306)   ! 
  3307) 
  3308)   use Realization_Subsurface_class
  3309)   use Patch_module
  3310)   use Grid_module
  3311)   use Option_module
  3312)   use Logging_module
  3313)   use Debug_module
  3314) 
  3315)   implicit none
  3316) 
  3317)   SNES :: snes
  3318)   Vec :: xx
  3319)   Mat :: A, B, J
  3320)   MatType :: mat_type
  3321)   type(realization_subsurface_type) :: realization
  3322)   PetscErrorCode :: ierr
  3323)   PetscViewer :: viewer
  3324)   type(patch_type), pointer :: cur_patch
  3325)   type(grid_type),  pointer :: grid
  3326)   character(len=MAXSTRINGLENGTH) :: string
  3327) 
  3328)   call PetscLogEventBegin(logging%event_r_jacobian,ierr);CHKERRQ(ierr)
  3329) 
  3330)   call MatGetType(A,mat_type,ierr);CHKERRQ(ierr)
  3331)   if (mat_type == MATMFFD) then
  3332)     J = B
  3333)     call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3334)     call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3335)   else
  3336)     J = A
  3337)   endif
  3338) 
  3339)   
  3340)   call MatZeroEntries(J,ierr);CHKERRQ(ierr)
  3341) 
  3342)  ! pass #1 for internal and boundary flux terms
  3343)   cur_patch => realization%patch_list%first
  3344)   do
  3345)     if (.not.associated(cur_patch)) exit
  3346)     realization%patch => cur_patch
  3347)     call Flash2JacobianPatch1(snes,xx,J,J,realization,ierr)
  3348)     cur_patch => cur_patch%next
  3349)   enddo
  3350) 
  3351) ! pass #2 for everything else
  3352)   cur_patch => realization%patch_list%first
  3353)   do
  3354)     if (.not.associated(cur_patch)) exit
  3355)     realization%patch => cur_patch
  3356)     call Flash2JacobianPatch2(snes,xx,J,J,realization,ierr)
  3357)     cur_patch => cur_patch%next
  3358)   enddo
  3359) 
  3360)   if (realization%debug%matview_Jacobian) then
  3361)     string = 'Fjacobian'
  3362)     call DebugCreateViewer(realization%debug,string,realization%option,viewer)
  3363)     call MatView(J,viewer,ierr);CHKERRQ(ierr)
  3364)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  3365)   endif
  3366) 
  3367) #if 0
  3368)   if (realization%debug%norm_Jacobian) then
  3369)     option => realization%option
  3370)     call MatNorm(J,NORM_1,norm,ierr);CHKERRQ(ierr)
  3371)     write(option%io_buffer,'("1 norm: ",es11.4)') norm
  3372)     call printMsg(option) 
  3373)     call MatNorm(J,NORM_FROBENIUS,norm,ierr);CHKERRQ(ierr)
  3374)     write(option%io_buffer,'("2 norm: ",es11.4)') norm
  3375)     call printMsg(option) 
  3376)     call MatNorm(J,NORM_INFINITY,norm,ierr);CHKERRQ(ierr)
  3377)     write(option%io_buffer,'("inf norm: ",es11.4)') norm
  3378)     call printMsg(option) 
  3379)   endif
  3380) #endif
  3381) 
  3382)   call PetscLogEventEnd(logging%event_r_jacobian,ierr);CHKERRQ(ierr)
  3383) 
  3384) end subroutine Flash2Jacobian
  3385) 
  3386) ! ************************************************************************** !
  3387) 
  3388) subroutine Flash2JacobianPatch(snes,xx,A,B,realization,ierr)
  3389)   ! 
  3390)   ! Computes the Jacobian
  3391)   ! 
  3392)   ! Author: Chuan Lu
  3393)   ! Date: 10/13/08
  3394)   ! 
  3395) 
  3396)   use Connection_module
  3397)   use Option_module
  3398)   use Grid_module
  3399)   use Realization_Subsurface_class
  3400)   use Patch_module
  3401)   use Coupler_module
  3402)   use Field_module
  3403)   use Debug_module
  3404)   use Material_Aux_class
  3405)   
  3406)   implicit none
  3407) 
  3408)   SNES :: snes
  3409)   Vec :: xx
  3410)   Mat :: A, B
  3411)   type(realization_subsurface_type) :: realization
  3412) 
  3413)   PetscErrorCode :: ierr
  3414)   PetscInt :: nvar,neq,nr
  3415)   PetscInt :: ithrm_up, ithrm_dn, i
  3416)   PetscInt :: ip1, ip2 
  3417) 
  3418)   PetscReal, pointer :: xx_loc_p(:), tortuosity_loc_p(:)
  3419)   PetscReal, pointer :: iphase_loc_p(:), icap_loc_p(:), ithrm_loc_p(:)
  3420)   PetscInt :: icap,iphas,iphas_up,iphas_dn,icap_up,icap_dn
  3421)   PetscInt :: ii, jj
  3422)   PetscReal :: dw_kg,dw_mol,enth_src_co2,enth_src_h2o,rho
  3423)   PetscReal :: tsrc1,qsrc1,csrc1,hsrc1
  3424)   PetscReal :: dd_up, dd_dn, dd, f_up, f_dn
  3425)   PetscReal :: perm_up, perm_dn
  3426)   PetscReal :: dw_dp,dw_dt,hw_dp,hw_dt,dresT_dp,dresT_dt
  3427)   PetscReal :: D_up, D_dn  ! "Diffusion" constants upstream and downstream of a face.
  3428)   PetscReal :: zero, norm
  3429)   PetscReal :: upweight
  3430)   PetscReal :: max_dev  
  3431)   PetscInt :: local_id, ghosted_id
  3432)   PetscInt :: local_id_up, local_id_dn
  3433)   PetscInt :: ghosted_id_up, ghosted_id_dn
  3434)   PetscInt :: natural_id_up,natural_id_dn
  3435)   
  3436)   PetscReal :: Jup(1:realization%option%nflowdof,1:realization%option%nflowdof), &
  3437)             Jdn(1:realization%option%nflowdof,1:realization%option%nflowdof)
  3438)   
  3439)   PetscInt :: istart, iend
  3440)   
  3441)   type(coupler_type), pointer :: boundary_condition, source_sink
  3442)   type(connection_set_list_type), pointer :: connection_set_list
  3443)   type(connection_set_type), pointer :: cur_connection_set
  3444)   PetscBool :: enthalpy_flag
  3445)   PetscInt :: iconn, idof
  3446)   PetscInt :: sum_connection  
  3447)   PetscReal :: distance, fraction_upwind
  3448)   PetscReal :: distance_gravity
  3449)   PetscReal :: Res(realization%option%nflowdof) 
  3450)   PetscReal :: xxbc(1:realization%option%nflowdof), delxbc(1:realization%option%nflowdof)
  3451)   PetscReal :: ResInc(realization%patch%grid%nlmax,realization%option%nflowdof, &
  3452)            realization%option%nflowdof)
  3453)   type(grid_type), pointer :: grid
  3454)   type(patch_type), pointer :: patch
  3455)   type(option_type), pointer :: option 
  3456)   type(field_type), pointer :: field 
  3457)   type(Flash2_parameter_type), pointer :: Flash2_parameter
  3458)   type(Flash2_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
  3459)   type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
  3460)   class(material_auxvar_type), pointer :: material_auxvars(:)
  3461)   
  3462)   PetscReal :: vv_darcy(realization%option%nphase), voltemp
  3463)   PetscReal :: ra(1:realization%option%nflowdof,1:realization%option%nflowdof*2)
  3464)   PetscInt nsrcpara 
  3465)   PetscReal, pointer :: msrc(:)
  3466)   PetscReal :: psrc(1:realization%option%nphase), ss_flow(1:realization%option%nphase)
  3467)   PetscReal :: dddt, dddp, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt,&
  3468)                dvdp, xphi
  3469)   PetscInt :: iphasebc                
  3470)   
  3471)   PetscViewer :: viewer
  3472)   Vec :: debug_vec
  3473)   character(len=MAXSTRINGLENGTH) :: string
  3474) 
  3475) !-----------------------------------------------------------------------
  3476) ! R stand for residual
  3477) !  ra       1              2              3              4          5              6            7      8
  3478) ! 1: p     dR/dpi         dR/dTi          dR/dci        dR/dsi   dR/dpim        dR/dTim
  3479) ! 2: T
  3480) ! 3: c
  3481) ! 4  s         
  3482) !-----------------------------------------------------------------------
  3483) 
  3484)   patch => realization%patch
  3485)   grid => patch%grid
  3486)   option => realization%option
  3487)   field => realization%field
  3488) 
  3489)   Flash2_parameter => patch%aux%Flash2%Flash2_parameter
  3490)   auxvars => patch%aux%Flash2%auxvars
  3491)   auxvars_bc => patch%aux%Flash2%auxvars_bc
  3492)   global_auxvars => patch%aux%Global%auxvars
  3493)   global_auxvars_bc => patch%aux%Global%auxvars_bc
  3494)   material_auxvars => patch%aux%Material%auxvars
  3495)   
  3496) ! dropped derivatives:
  3497) !   1.D0 gas phase viscocity to all p,t,c,s
  3498) !   2. Average molecular weights to p,t,s
  3499) 
  3500) #if 0
  3501) !  call Flash2NumericalJacobianTest(xx,realization)
  3502) #endif
  3503) 
  3504)  ! print *,'*********** In Jacobian ********************** '
  3505)   call MatZeroEntries(A,ierr);CHKERRQ(ierr)
  3506) 
  3507)   call VecGetArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
  3508) 
  3509)   call VecGetArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
  3510)   call VecGetArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
  3511) !  call VecGetArrayF90(field%iphas_loc, iphase_loc_p, ierr)
  3512) 
  3513)  ResInc = 0.D0
  3514) #if 1
  3515)   ! Accumulation terms ------------------------------------
  3516)   do local_id = 1, grid%nlmax  ! For each local node do...
  3517)     ghosted_id = grid%nL2G(local_id)
  3518)     !geh - Ignore inactive cells with inactive materials
  3519)     if (associated(patch%imat)) then
  3520)       if (patch%imat(ghosted_id) <= 0) cycle
  3521)     endif
  3522)     iend = local_id*option%nflowdof
  3523)     istart = iend-option%nflowdof+1
  3524)     icap = int(icap_loc_p(ghosted_id))
  3525)      
  3526)     do nvar =1, option%nflowdof
  3527)       call Flash2Accumulation(auxvars(ghosted_id)%auxvar_elem(nvar), &
  3528)              global_auxvars(ghosted_id),& 
  3529)              material_auxvars(ghosted_id)%porosity, &
  3530)              material_auxvars(ghosted_id)%volume, &
  3531)              Flash2_parameter%dencpr(int(ithrm_loc_p(ghosted_id))), &
  3532)              option,ONE_INTEGER, res) 
  3533)       ResInc( local_id,:,nvar) =  ResInc(local_id,:,nvar) + Res(:)
  3534)     enddo
  3535)   enddo
  3536) #endif
  3537) #if 1
  3538)   ! Source/sink terms -------------------------------------
  3539)   source_sink => patch%source_sink_list%first
  3540)   sum_connection = 0 
  3541)   do 
  3542)     if (.not.associated(source_sink)) exit
  3543)     
  3544)     ! check whether enthalpy dof is included
  3545)   !  if (source_sink%flow_condition%num_sub_conditions > 3) then
  3546)       enthalpy_flag = PETSC_TRUE
  3547)    ! else
  3548)    !   enthalpy_flag = PETSC_FALSE
  3549)    ! endif
  3550)     if (associated(source_sink%flow_condition%pressure)) then
  3551)       psrc(:) = source_sink%flow_condition%pressure%dataset%rarray(:)
  3552)     endif
  3553)     tsrc1 = source_sink%flow_condition%temperature%dataset%rarray(1)
  3554)     csrc1 = source_sink%flow_condition%concentration%dataset%rarray(1)
  3555)  !   hsrc1=0.D0
  3556)     if (enthalpy_flag) hsrc1 = source_sink%flow_condition%enthalpy%dataset%rarray(1)
  3557) 
  3558)    ! qsrc1 = qsrc1 / FMWH2O ! [kg/s -> kmol/s; fmw -> g/mol = kg/kmol]
  3559)    ! csrc1 = csrc1 / FMWCO2
  3560)     select case(source_sink%flow_condition%itype(1))
  3561)       case(MASS_RATE_SS)
  3562)         msrc => source_sink%flow_condition%rate%dataset%rarray
  3563)         nsrcpara= 2
  3564)       case(WELL_SS)
  3565)         msrc => source_sink%flow_condition%well%dataset%rarray
  3566)         nsrcpara = 7 + option%nflowspec 
  3567)       case default
  3568)         print *, 'Flash mode does not support source/sink type: ', source_sink%flow_condition%itype(1)
  3569)         stop  
  3570)     end select
  3571)  
  3572)     cur_connection_set => source_sink%connection_set
  3573)  
  3574)     do iconn = 1, cur_connection_set%num_connections      
  3575)       sum_connection = sum_connection + 1 
  3576)       local_id = cur_connection_set%id_dn(iconn)
  3577)       ghosted_id = grid%nL2G(local_id)
  3578) 
  3579)       if (associated(patch%imat)) then
  3580)         if (patch%imat(ghosted_id) <= 0) cycle
  3581)       endif
  3582) !      if (enthalpy_flag) then
  3583) !        r_p(local_id*option%nflowdof) = r_p(local_id*option%nflowdof) - hsrc1 * option%flow_dt   
  3584) !      endif         
  3585)       do nvar =1, option%nflowdof
  3586)         call Flash2SourceSink(msrc,nsrcpara,psrc,tsrc1,hsrc1,csrc1, auxvars(ghosted_id)%auxvar_elem(nvar),&
  3587)                             source_sink%flow_condition%itype(1), Res,&
  3588)                             ss_flow, &
  3589)                             enthalpy_flag, option)
  3590)       
  3591)         ResInc(local_id,jh2o,nvar)=  ResInc(local_id,jh2o,nvar) - Res(jh2o)
  3592)         ResInc(local_id,jco2,nvar)=  ResInc(local_id,jco2,nvar) - Res(jco2)
  3593)         if (enthalpy_flag) &
  3594)           ResInc(local_id,option%nflowdof,nvar)=&
  3595)           ResInc(local_id,option%nflowdof,nvar)- Res(option%nflowdof)
  3596) 
  3597)       enddo
  3598)     enddo
  3599)     source_sink => source_sink%next
  3600)   enddo
  3601) #endif
  3602) ! Boundary conditions
  3603) #if 1
  3604)   ! Boundary Flux Terms -----------------------------------
  3605)   boundary_condition => patch%boundary_condition_list%first
  3606)   sum_connection = 0    
  3607)   do 
  3608)     if (.not.associated(boundary_condition)) exit
  3609)     
  3610)     cur_connection_set => boundary_condition%connection_set
  3611)     
  3612)     do iconn = 1, cur_connection_set%num_connections
  3613)       sum_connection = sum_connection + 1
  3614)     
  3615)       local_id = cur_connection_set%id_dn(iconn)
  3616)       ghosted_id = grid%nL2G(local_id)
  3617) 
  3618)       if (associated(patch%imat)) then
  3619)         if (patch%imat(ghosted_id) <= 0) cycle
  3620)       endif
  3621) 
  3622)       if (ghosted_id<=0) then
  3623)         print *, "Wrong boundary node index... STOP!!!"
  3624)         stop
  3625)       endif
  3626) 
  3627)       ithrm_dn = int(ithrm_loc_p(ghosted_id))
  3628)       D_dn = Flash2_parameter%ckwet(ithrm_dn)
  3629) 
  3630)       ! for now, just assume diagonal tensor
  3631)       call material_auxvars(ghosted_id)%PermeabilityTensorToScalar( &
  3632)                             cur_connection_set%dist(:,iconn),perm_dn)
  3633)       ! dist(0,iconn) = scalar - magnitude of distance
  3634)       ! gravity = vector(3)
  3635)       ! dist(1:3,iconn) = vector(3) - unit vector
  3636)       distance_gravity = cur_connection_set%dist(0,iconn) * &
  3637)                          dot_product(option%gravity, &
  3638)                                      cur_connection_set%dist(1:3,iconn))
  3639)       icap_dn = int(icap_loc_p(ghosted_id))
  3640) 
  3641) ! Then need fill up increments for BCs
  3642)       delxbc = 0.D0;
  3643)       do idof = 1, option%nflowdof
  3644)         select case(boundary_condition%flow_condition%itype(idof))
  3645)         case(DIRICHLET_BC)
  3646)           xxbc(idof) = boundary_condition%flow_aux_real_var(idof,iconn)
  3647)           delxbc(idof)=0.D0
  3648)         case(HYDROSTATIC_BC)
  3649)           xxbc(1) = boundary_condition%flow_aux_real_var(1,iconn)
  3650)           if (idof >= 2) then
  3651)              xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
  3652)              delxbc(idof)=patch%aux%Flash2%delx(idof,ghosted_id)
  3653)           endif 
  3654)         case(NEUMANN_BC, ZERO_GRADIENT_BC)
  3655)           ! solve for pb from Darcy's law given qb /= 0
  3656)           xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
  3657)           !iphasebc = int(iphase_loc_p(ghosted_id))
  3658)           delxbc(idof)=patch%aux%Flash2%delx(idof,ghosted_id)
  3659)         end select
  3660)       enddo
  3661)       !print *,'BC:',boundary_condition%flow_condition%itype, xxbc, delxbc
  3662) 
  3663)  
  3664)       call Flash2AuxVarCompute_Ninc(xxbc,auxvars_bc(sum_connection)%auxvar_elem(0),&
  3665)          global_auxvars_bc(sum_connection),&
  3666)          patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr,&
  3667)          realization%fluid_properties, option)
  3668)       call Flash2AuxVarCompute_Winc(xxbc,delxbc,&
  3669)          auxvars_bc(sum_connection)%auxvar_elem(1:option%nflowdof),&
  3670)          global_auxvars_bc(sum_connection),&
  3671)          patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr,&
  3672)          realization%fluid_properties,option)
  3673)     
  3674)       do nvar=1,option%nflowdof
  3675)         call Flash2BCFlux(boundary_condition%flow_condition%itype, &
  3676)           boundary_condition%flow_aux_real_var(:,iconn), &
  3677)           auxvars_bc(sum_connection)%auxvar_elem(nvar), &
  3678)           auxvars(ghosted_id)%auxvar_elem(nvar), &
  3679)           material_auxvars(ghosted_id)%porosity, &
  3680)           material_auxvars(ghosted_id)%tortuosity, &
  3681)           Flash2_parameter%sir(:,icap_dn), &
  3682)           cur_connection_set%dist(0,iconn),perm_dn,D_dn, &
  3683)           cur_connection_set%area(iconn), &
  3684)           distance_gravity,option, &
  3685)           vv_darcy,Res)
  3686)         ResInc(local_id,1:option%nflowdof,nvar) = &
  3687)         ResInc(local_id,1:option%nflowdof,nvar) - Res(1:option%nflowdof)
  3688)       enddo
  3689)     enddo
  3690)     boundary_condition => boundary_condition%next
  3691)   enddo
  3692) #endif
  3693) ! Set matrix values related to single node terms: Accumulation, Source/Sink, BC
  3694)   do local_id = 1, grid%nlmax  ! For each local node do...
  3695)     ghosted_id = grid%nL2G(local_id)
  3696)     !geh - Ignore inactive cells with inactive materials
  3697)     if (associated(patch%imat)) then
  3698)       if (patch%imat(ghosted_id) <= 0) cycle
  3699)     endif
  3700) 
  3701)     ra=0.D0
  3702)     max_dev=0.D0
  3703)     do neq=1, option%nflowdof
  3704)       do nvar=1, option%nflowdof
  3705)         ra(neq,nvar)=(ResInc(local_id,neq,nvar)-patch%aux%Flash2%ResOld_AR(local_id,neq))&
  3706)               /patch%aux%Flash2%delx(nvar,ghosted_id)
  3707)         if (max_dev < dabs(ra(3,nvar))) max_dev = dabs(ra(3,nvar))
  3708)       enddo
  3709)     enddo
  3710)    
  3711)     select case(option%idt_switch)
  3712)       case(1) 
  3713)         ra(1:option%nflowdof,1:option%nflowdof) = &
  3714)           ra(1:option%nflowdof,1:option%nflowdof) /option%flow_dt
  3715)       case(-1)
  3716)         if (option%flow_dt>1) ra(1:option%nflowdof,1:option%nflowdof) = &
  3717)           ra(1:option%nflowdof,1:option%nflowdof) /option%flow_dt
  3718)     end select
  3719) 
  3720)     Jup = ra(1:option%nflowdof,1:option%nflowdof)
  3721)     if (material_auxvars(ghosted_id)%volume > 1.D0) Jup=Jup / material_auxvars(ghosted_id)%volume
  3722)    
  3723) !      if (local_id==1) print *, 'flash jac', volume_p(local_id), ra
  3724)     call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jup,ADD_VALUES, &
  3725)                                   ierr);CHKERRQ(ierr)
  3726)   end do
  3727) 
  3728)   if (realization%debug%matview_Jacobian_detailed) then
  3729)     call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3730)     call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3731)     string = 'jacobian_srcsink'
  3732)     call DebugCreateViewer(realization%debug,string,option,viewer)
  3733)     call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRQ(ierr)
  3734)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  3735)   endif
  3736) #if 1
  3737)   ! Interior Flux Terms -----------------------------------  
  3738)   connection_set_list => grid%internal_connection_set_list
  3739)   cur_connection_set => connection_set_list%first
  3740)   sum_connection = 0    
  3741)   ResInc = 0.D0
  3742)   do 
  3743)     if (.not.associated(cur_connection_set)) exit
  3744)     do iconn = 1, cur_connection_set%num_connections
  3745)       sum_connection = sum_connection + 1
  3746)     
  3747)       ghosted_id_up = cur_connection_set%id_up(iconn)
  3748)       ghosted_id_dn = cur_connection_set%id_dn(iconn)
  3749) 
  3750)       if (associated(patch%imat)) then
  3751)         if (patch%imat(ghosted_id_up) <= 0 .or. &
  3752)             patch%imat(ghosted_id_dn) <= 0) cycle
  3753)       endif
  3754) 
  3755)       local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
  3756)       local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping   
  3757)      ! natural_id_up = grid%nG2N(ghosted_id_up)
  3758)      ! natural_id_dn = grid%nG2N(ghosted_id_dn)
  3759)    
  3760)       fraction_upwind = cur_connection_set%dist(-1,iconn)
  3761)       distance = cur_connection_set%dist(0,iconn)
  3762)       ! distance = scalar - magnitude of distance
  3763)       ! gravity = vector(3)
  3764)       ! dist(1:3,iconn) = vector(3) - unit vector
  3765)       distance_gravity = distance * &
  3766)                          dot_product(option%gravity, &
  3767)                                      cur_connection_set%dist(1:3,iconn))
  3768)       dd_up = distance*fraction_upwind
  3769)       dd_dn = distance-dd_up ! should avoid truncation error
  3770)       ! upweight could be calculated as 1.d0-fraction_upwind
  3771)       ! however, this introduces ever so slight error causing pflow-overhaul not
  3772)       ! to match pflow-orig.  This can be changed to 1.d0-fraction_upwind
  3773)       upweight = dd_dn/(dd_up+dd_dn)
  3774)     
  3775)       ! for now, just assume diagonal tensor
  3776)       call material_auxvars(ghosted_id_up)%PermeabilityTensorToScalar( &
  3777)                             cur_connection_set%dist(:,iconn),perm_up)
  3778)       call material_auxvars(ghosted_id_dn)%PermeabilityTensorToScalar( &
  3779)                             cur_connection_set%dist(:,iconn),perm_dn)
  3780)     
  3781)       ithrm_up = int(ithrm_loc_p(ghosted_id_up))
  3782)       ithrm_dn = int(ithrm_loc_p(ghosted_id_dn))
  3783)       D_up = Flash2_parameter%ckwet(ithrm_up)
  3784)       D_dn = Flash2_parameter%ckwet(ithrm_dn)
  3785)     
  3786)       icap_up = int(icap_loc_p(ghosted_id_up))
  3787)       icap_dn = int(icap_loc_p(ghosted_id_dn))
  3788)       
  3789)       do nvar = 1, option%nflowdof 
  3790)         call Flash2Flux(auxvars(ghosted_id_up)%auxvar_elem(nvar), &
  3791)                          material_auxvars(ghosted_id_up)%porosity, &
  3792)                          material_auxvars(ghosted_id_up)%tortuosity, &
  3793)                          Flash2_parameter%sir(:,icap_up), &
  3794)                          dd_up,perm_up,D_up, &
  3795)                          auxvars(ghosted_id_dn)%auxvar_elem(0), &
  3796)                          material_auxvars(ghosted_id_dn)%porosity, &
  3797)                          material_auxvars(ghosted_id_dn)%tortuosity, &
  3798)                          Flash2_parameter%sir(:,icap_dn), &
  3799)                          dd_dn,perm_dn,D_dn, &
  3800)                          cur_connection_set%area(iconn),distance_gravity, &
  3801)                          upweight, option, vv_darcy, Res)
  3802)         ra(:,nvar)= (Res(:)-patch%aux%Flash2%ResOld_FL(iconn,:))&
  3803)               /patch%aux%Flash2%delx(nvar,ghosted_id_up)
  3804)         call Flash2Flux(auxvars(ghosted_id_up)%auxvar_elem(0), &
  3805)                          material_auxvars(ghosted_id_up)%porosity, &
  3806)                          material_auxvars(ghosted_id_up)%tortuosity, &
  3807)                          Flash2_parameter%sir(:,icap_up), &
  3808)                          dd_up,perm_up,D_up, &
  3809)                          auxvars(ghosted_id_dn)%auxvar_elem(nvar), &
  3810)                          material_auxvars(ghosted_id_dn)%porosity, &
  3811)                          material_auxvars(ghosted_id_dn)%tortuosity, &
  3812)                          Flash2_parameter%sir(:,icap_dn), &
  3813)                          dd_dn,perm_dn,D_dn, &
  3814)                          cur_connection_set%area(iconn),distance_gravity, &
  3815)                          upweight, option, vv_darcy, Res)
  3816)         ra(:,nvar+option%nflowdof)= (Res(:)-patch%aux%Flash2%ResOld_FL(iconn,:))&
  3817)            /patch%aux%Flash2%delx(nvar,ghosted_id_dn)
  3818)       enddo
  3819) 
  3820)       select case(option%idt_switch)
  3821)       case(1)
  3822)         ra = ra / option%flow_dt
  3823)       case(-1)
  3824)         if (option%flow_dt > 1)  ra = ra / option%flow_dt
  3825)       end select
  3826)     
  3827)       if (local_id_up > 0) then
  3828)         voltemp=1.D0
  3829)         if (material_auxvars(ghosted_id_up)%volume > 1.D0) then
  3830)           voltemp = 1.D0/material_auxvars(ghosted_id_up)%volume
  3831)         endif
  3832)         Jup(:,1:option%nflowdof)= ra(:,1:option%nflowdof)*voltemp !11
  3833)         jdn(:,1:option%nflowdof)= ra(:, 1 + option%nflowdof:2 * option%nflowdof)*voltemp !12
  3834) 
  3835)         call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_up-1, &
  3836)             Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
  3837)         call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_dn-1, &
  3838)             Jdn,ADD_VALUES,ierr);CHKERRQ(ierr)
  3839)       endif
  3840)       if (local_id_dn > 0) then
  3841)         voltemp=1.D0
  3842)         if (material_auxvars(ghosted_id_dn)%volume > 1.D0) then
  3843)           voltemp = 1.D0/material_auxvars(ghosted_id_dn)%volume
  3844)         endif
  3845)         Jup(:,1:option%nflowdof)= -ra(:,1:option%nflowdof)*voltemp !21
  3846)         jdn(:,1:option%nflowdof)= -ra(:, 1 + option%nflowdof:2 * option%nflowdof)*voltemp !22
  3847) 
  3848)  
  3849)         call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_dn-1, &
  3850)             Jdn,ADD_VALUES,ierr);CHKERRQ(ierr)
  3851)         call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_up-1, &
  3852)             Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
  3853)       endif
  3854)     enddo
  3855)     cur_connection_set => cur_connection_set%next
  3856)   enddo
  3857) #endif
  3858)   if (realization%debug%matview_Jacobian_detailed) then
  3859)  ! print *,'end inter flux'
  3860)     call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3861)     call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3862)     string = 'jacobian_flux'
  3863)     call DebugCreateViewer(realization%debug,string,option,viewer)
  3864)     call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRQ(ierr)
  3865)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  3866)   endif
  3867) #if 0
  3868)   if (realization%debug%matview_Jacobian_detailed) then
  3869)     call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3870)     call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3871)     call PetscViewerASCIIOpen(option%mycomm,'jacobian_bcflux.out',viewer, &
  3872)                               ierr);CHKERRQ(ierr)
  3873)     call MatView(A,viewer,ierr);CHKERRQ(ierr)
  3874)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  3875)   endif
  3876) #endif
  3877)   
  3878)   call VecRestoreArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
  3879)   call VecRestoreArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
  3880)   call VecRestoreArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
  3881) ! call VecRestoreArrayF90(field%iphas_loc, iphase_loc_p, ierr)
  3882) ! print *,'end jac'
  3883)   call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3884)   call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3885)  ! call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr)
  3886) #if 0
  3887) ! zero out isothermal and inactive cells
  3888) #ifdef ISOTHERMAL
  3889)   zero = 0.d0
  3890)   call MatZeroRowsLocal(A,n_zero_rows,zero_rows_local_ghosted,zero, &
  3891)                         PETSC_NULL_OBJECT,PETSC_NULL_OBJECT, &
  3892)                         ierr);CHKERRQ(ierr)
  3893)   do i=1, n_zero_rows
  3894)     ii = mod(zero_rows_local(i),option%nflowdof)
  3895)     ip1 = zero_rows_local_ghosted(i)
  3896)     if (ii == 0) then
  3897)       ip2 = ip1-1
  3898)     elseif (ii == option%nflowdof-1) then
  3899)       ip2 = ip1+1
  3900)     else
  3901)       ip2 = ip1
  3902)     endif
  3903)     call MatSetValuesLocal(A,1,ip1,1,ip2,1.d0,INSERT_VALUES, &
  3904)                            ierr);CHKERRQ(ierr)
  3905)   enddo
  3906) 
  3907)   call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3908)   call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3909) #else
  3910) #endif
  3911) #endif
  3912) 
  3913)   if (patch%aux%Flash2%inactive_cells_exist) then
  3914)     f_up = 1.d0
  3915)     call MatZeroRowsLocal(A,patch%aux%Flash2%n_zero_rows, &
  3916)                           patch%aux%Flash2%zero_rows_local_ghosted,f_up, &
  3917)                           PETSC_NULL_OBJECT,PETSC_NULL_OBJECT, &
  3918)                           ierr);CHKERRQ(ierr)
  3919)   endif
  3920) 
  3921)   if (realization%debug%matview_Jacobian) then
  3922)     string = 'Fjacobian'
  3923)     call DebugCreateViewer(realization%debug,string,option,viewer)
  3924)     call MatView(A,viewer,ierr);CHKERRQ(ierr)
  3925)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  3926)   endif
  3927)   if (realization%debug%norm_Jacobian) then
  3928)     call MatNorm(A,NORM_1,norm,ierr);CHKERRQ(ierr)
  3929)     write(option%io_buffer,'("1 norm: ",es11.4)') norm
  3930)     call printMsg(option)
  3931)     call MatNorm(A,NORM_FROBENIUS,norm,ierr);CHKERRQ(ierr)
  3932)     write(option%io_buffer,'("2 norm: ",es11.4)') norm
  3933)     call printMsg(option)
  3934)     call MatNorm(A,NORM_INFINITY,norm,ierr);CHKERRQ(ierr)
  3935)     write(option%io_buffer,'("inf norm: ",es11.4)') norm
  3936)     call printMsg(option)
  3937) !    call GridCreateVector(grid,ONEDOF,debug_vec,GLOBAL)
  3938) !    call MatGetRowMaxAbs(A,debug_vec,PETSC_NULL_INTEGER,ierr)
  3939) !    call VecMax(debug_vec,i,norm,ierr)
  3940) !    call VecDestroy(debug_vec,ierr)
  3941)   endif
  3942) end subroutine Flash2JacobianPatch
  3943) 
  3944) ! ************************************************************************** !
  3945) 
  3946) subroutine Flash2JacobianPatch1(snes,xx,A,B,realization,ierr)
  3947)   ! 
  3948)   ! Flash2JacobianPatch: Computes the Jacobian: Flux term
  3949)   ! 
  3950)   ! Author: Chuan Lu
  3951)   ! Date: 10/13/08
  3952)   ! 
  3953) 
  3954)   use Connection_module
  3955)   use Option_module
  3956)   use Grid_module
  3957)   use Realization_Subsurface_class
  3958)   use Patch_module
  3959)   use Coupler_module
  3960)   use Field_module
  3961)   use Debug_module
  3962)   use Material_Aux_class
  3963)   
  3964)   implicit none
  3965) 
  3966)   SNES :: snes
  3967)   Vec :: xx
  3968)   Mat :: A, B
  3969)   type(realization_subsurface_type) :: realization
  3970) 
  3971)   PetscErrorCode :: ierr
  3972)   PetscInt :: nvar,neq,nr
  3973)   PetscInt :: ithrm_up, ithrm_dn, i
  3974)   PetscInt :: ip1, ip2 
  3975) 
  3976)   PetscReal, pointer :: xx_loc_p(:), tortuosity_loc_p(:)
  3977)   PetscReal, pointer :: iphase_loc_p(:), icap_loc_p(:), ithrm_loc_p(:)
  3978)   PetscInt :: icap,iphas,iphas_up,iphas_dn,icap_up,icap_dn
  3979)   PetscInt :: ii, jj
  3980)   PetscReal :: dw_kg,dw_mol,enth_src_co2,enth_src_h2o,rho
  3981)   PetscReal :: tsrc1,qsrc1,csrc1,hsrc1
  3982)   PetscReal :: dd_up, dd_dn, dd, f_up, f_dn
  3983)   PetscReal :: perm_up, perm_dn
  3984)   PetscReal :: dw_dp,dw_dt,hw_dp,hw_dt,dresT_dp,dresT_dt
  3985)   PetscReal :: D_up, D_dn  ! "Diffusion" constants upstream and downstream of a face.
  3986)   PetscReal :: zero, norm
  3987)   PetscReal :: upweight
  3988)   PetscReal :: max_dev  
  3989)   PetscInt :: local_id, ghosted_id
  3990)   PetscInt :: local_id_up, local_id_dn
  3991)   PetscInt :: ghosted_id_up, ghosted_id_dn
  3992)   PetscInt ::  natural_id_up,natural_id_dn
  3993)   
  3994)   PetscReal :: Jup(1:realization%option%nflowdof,1:realization%option%nflowdof), &
  3995)             Jdn(1:realization%option%nflowdof,1:realization%option%nflowdof)
  3996)   
  3997)   PetscInt :: istart, iend
  3998)   
  3999)   type(coupler_type), pointer :: boundary_condition, source_sink
  4000)   type(connection_set_list_type), pointer :: connection_set_list
  4001)   type(connection_set_type), pointer :: cur_connection_set
  4002)   PetscBool :: enthalpy_flag
  4003)   PetscInt :: iconn, idof
  4004)   PetscInt :: sum_connection  
  4005)   PetscReal :: distance, fraction_upwind
  4006)   PetscReal :: distance_gravity
  4007)   PetscReal :: Res(realization%option%nflowdof) 
  4008)   PetscReal :: xxbc(1:realization%option%nflowdof), delxbc(1:realization%option%nflowdof)
  4009)   PetscReal :: ResInc(realization%patch%grid%nlmax,realization%option%nflowdof,&
  4010)            realization%option%nflowdof)
  4011)   type(grid_type), pointer :: grid
  4012)   type(patch_type), pointer :: patch
  4013)   type(option_type), pointer :: option 
  4014)   type(field_type), pointer :: field 
  4015)   type(Flash2_parameter_type), pointer :: Flash2_parameter
  4016)   type(Flash2_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
  4017)   type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
  4018)   class(material_auxvar_type), pointer :: material_auxvars(:)
  4019)   
  4020)   PetscReal :: vv_darcy(realization%option%nphase), voltemp
  4021)   PetscReal :: ra(1:realization%option%nflowdof,1:realization%option%nflowdof*2) 
  4022)   PetscReal :: msrc(1:realization%option%nflowspec)
  4023)   PetscReal :: psrc(1:realization%option%nphase)
  4024)   PetscReal :: dddt, dddp, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt,&
  4025)                dvdp, xphi
  4026)   PetscInt :: iphasebc                
  4027)   
  4028)   PetscViewer :: viewer
  4029)   Vec :: debug_vec
  4030)   character(len=MAXSTRINGLENGTH) :: string
  4031) 
  4032) !-----------------------------------------------------------------------
  4033) ! R stand for residual
  4034) !  ra       1              2              3              4          5              6            7      8
  4035) ! 1: p     dR/dpi         dR/dTi          dR/dci        dR/dsi   dR/dpim        dR/dTim
  4036) ! 2: T
  4037) ! 3: c
  4038) ! 4  s         
  4039) !-----------------------------------------------------------------------
  4040) 
  4041)   patch => realization%patch
  4042)   grid => patch%grid
  4043)   option => realization%option
  4044)   field => realization%field
  4045) 
  4046)   Flash2_parameter => patch%aux%Flash2%Flash2_parameter
  4047)   auxvars => patch%aux%Flash2%auxvars
  4048)   auxvars_bc => patch%aux%Flash2%auxvars_bc
  4049)   global_auxvars => patch%aux%Global%auxvars
  4050)   global_auxvars_bc => patch%aux%Global%auxvars_bc
  4051)   material_auxvars => patch%aux%Material%auxvars
  4052) ! dropped derivatives:
  4053) !   1.D0 gas phase viscocity to all p,t,c,s
  4054) !   2. Average molecular weights to p,t,s
  4055) 
  4056) #if 0
  4057) !  call Flash2NumericalJacobianTest(xx,realization)
  4058) #endif
  4059) 
  4060)  ! print *,'*********** In Jacobian ********************** '
  4061)  ! MatzeroEntries has been called in Flash2Jacobin ! clu removed on 11/04/2010 
  4062)  !  call MatZeroEntries(A,ierr)
  4063) 
  4064)   call VecGetArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
  4065)   call VecGetArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
  4066)   call VecGetArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
  4067) !  call VecGetArrayF90(field%iphas_loc, iphase_loc_p, ierr)
  4068) 
  4069)  ResInc = 0.D0
  4070) 
  4071) ! Boundary conditions
  4072) #if 1
  4073)   ! Boundary Flux Terms -----------------------------------
  4074)   boundary_condition => patch%boundary_condition_list%first
  4075)   sum_connection = 0    
  4076)   do 
  4077)     if (.not.associated(boundary_condition)) exit
  4078)     
  4079)     cur_connection_set => boundary_condition%connection_set
  4080)     
  4081)     do iconn = 1, cur_connection_set%num_connections
  4082)       sum_connection = sum_connection + 1
  4083)     
  4084)       local_id = cur_connection_set%id_dn(iconn)
  4085)       ghosted_id = grid%nL2G(local_id)
  4086) 
  4087)       if (associated(patch%imat)) then
  4088)         if (patch%imat(ghosted_id) <= 0) cycle
  4089)       endif
  4090) 
  4091)       if (ghosted_id<=0) then
  4092)         print *, "Wrong boundary node index... STOP!!!"
  4093)         stop
  4094)       endif
  4095) 
  4096)       ithrm_dn = int(ithrm_loc_p(ghosted_id))
  4097)       D_dn = Flash2_parameter%ckwet(ithrm_dn)
  4098) 
  4099)       ! for now, just assume diagonal tensor
  4100)       call material_auxvars(ghosted_id)%PermeabilityTensorToScalar( &
  4101)                             cur_connection_set%dist(:,iconn),perm_dn)
  4102)       ! dist(0,iconn) = scalar - magnitude of distance
  4103)       ! gravity = vector(3)
  4104)       ! dist(1:3,iconn) = vector(3) - unit vector
  4105)       distance_gravity = cur_connection_set%dist(0,iconn) * &
  4106)                          dot_product(option%gravity, &
  4107)                                      cur_connection_set%dist(1:3,iconn))
  4108)       icap_dn = int(icap_loc_p(ghosted_id))
  4109) 
  4110) ! Then need fill up increments for BCs
  4111)       delxbc = 0.D0;
  4112)       do idof = 1, option%nflowdof
  4113)         select case(boundary_condition%flow_condition%itype(idof))
  4114)         case(DIRICHLET_BC)
  4115)           xxbc(idof) = boundary_condition%flow_aux_real_var(idof,iconn)
  4116)           delxbc(idof)=0.D0
  4117)         case(HYDROSTATIC_BC)
  4118)           xxbc(1) = boundary_condition%flow_aux_real_var(1,iconn)
  4119)           if (idof>=2)then
  4120)              xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
  4121)              delxbc(idof)=patch%aux%Flash2%delx(idof,ghosted_id)
  4122)           endif 
  4123)         case(NEUMANN_BC, ZERO_GRADIENT_BC)
  4124)           ! solve for pb from Darcy's law given qb /= 0
  4125)           xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
  4126)           !iphasebc = int(iphase_loc_p(ghosted_id))
  4127)           delxbc(idof)=patch%aux%Flash2%delx(idof,ghosted_id)
  4128)         end select
  4129)       enddo
  4130)     !print *,'BC:',boundary_condition%flow_condition%itype, xxbc, delxbc
  4131) 
  4132)  
  4133)       call Flash2AuxVarCompute_Ninc(xxbc,auxvars_bc(sum_connection)%auxvar_elem(0),&
  4134)          global_auxvars_bc(sum_connection),&
  4135)          patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr,&
  4136)          realization%fluid_properties, option)
  4137)       call Flash2AuxVarCompute_Winc(xxbc,delxbc,&
  4138)          auxvars_bc(sum_connection)%auxvar_elem(1:option%nflowdof),&
  4139)          global_auxvars_bc(sum_connection),&
  4140)          patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr,&
  4141)          realization%fluid_properties,option)
  4142)     
  4143)       do nvar=1,option%nflowdof
  4144)         call Flash2BCFlux(boundary_condition%flow_condition%itype, &
  4145)           boundary_condition%flow_aux_real_var(:,iconn), &
  4146)           auxvars_bc(sum_connection)%auxvar_elem(nvar), &
  4147)           auxvars(ghosted_id)%auxvar_elem(nvar), &
  4148)           material_auxvars(ghosted_id)%porosity, &
  4149)           material_auxvars(ghosted_id)%tortuosity, &
  4150)           Flash2_parameter%sir(:,icap_dn), &
  4151)           cur_connection_set%dist(0,iconn),perm_dn,D_dn, &
  4152)           cur_connection_set%area(iconn), &
  4153)           distance_gravity,option, &
  4154)           vv_darcy,Res)
  4155)         ResInc(local_id,1:option%nflowdof,nvar) = ResInc(local_id,1:option%nflowdof,nvar) - Res(1:option%nflowdof)
  4156)       enddo
  4157)     enddo
  4158)     boundary_condition => boundary_condition%next
  4159)   enddo
  4160) #endif
  4161) ! Set matrix values related to single node terms: Accumulation, Source/Sink, BC
  4162)   do local_id = 1, grid%nlmax  ! For each local node do...
  4163)      ghosted_id = grid%nL2G(local_id)
  4164)      !geh - Ignore inactive cells with inactive materials
  4165)      if (associated(patch%imat)) then
  4166)         if (patch%imat(ghosted_id) <= 0) cycle
  4167)      endif
  4168) 
  4169)      ra=0.D0
  4170)      max_dev=0.D0
  4171)      do neq=1, option%nflowdof
  4172)         do nvar=1, option%nflowdof
  4173)            ra(neq,nvar)=(ResInc(local_id,neq,nvar)-patch%aux%Flash2%ResOld_BC(local_id,neq))&
  4174)               /patch%aux%Flash2%delx(nvar,ghosted_id)
  4175)            if (max_dev < dabs(ra(3,nvar))) max_dev = dabs(ra(3,nvar))
  4176)         enddo
  4177)      enddo
  4178)    
  4179)    select case(option%idt_switch)
  4180)       case(1) 
  4181)         ra(1:option%nflowdof,1:option%nflowdof) = &
  4182)           ra(1:option%nflowdof,1:option%nflowdof) /option%flow_dt
  4183)       case(-1)
  4184)         if (option%flow_dt>1) ra(1:option%nflowdof,1:option%nflowdof) = &
  4185)                                 ra(1:option%nflowdof,1:option%nflowdof) /option%flow_dt
  4186)     end select
  4187) 
  4188)      Jup=ra(1:option%nflowdof,1:option%nflowdof)
  4189)      if (material_auxvars(ghosted_id)%volume>1.D0 ) Jup=Jup / material_auxvars(ghosted_id)%volume
  4190)    
  4191) !      if (local_id==1) print *, 'flash jac', volume_p(local_id), ra
  4192)      call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jup,ADD_VALUES, &
  4193)                                    ierr);CHKERRQ(ierr)
  4194)   end do
  4195) 
  4196)   if (realization%debug%matview_Jacobian_detailed) then
  4197)     call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  4198)     call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  4199)     string = 'jacobian_bcflux'
  4200)     call DebugCreateViewer(realization%debug,string,option,viewer)
  4201)     call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRQ(ierr)
  4202)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  4203)   endif
  4204) 
  4205) #if 1
  4206)   ! Interior Flux Terms -----------------------------------  
  4207)   connection_set_list => grid%internal_connection_set_list
  4208)   cur_connection_set => connection_set_list%first
  4209)   sum_connection = 0    
  4210)   ResInc = 0.D0
  4211)   do 
  4212)     if (.not.associated(cur_connection_set)) exit
  4213)     do iconn = 1, cur_connection_set%num_connections
  4214)       sum_connection = sum_connection + 1
  4215)     
  4216)       ghosted_id_up = cur_connection_set%id_up(iconn)
  4217)       ghosted_id_dn = cur_connection_set%id_dn(iconn)
  4218) 
  4219)       if (associated(patch%imat)) then
  4220)         if (patch%imat(ghosted_id_up) <= 0 .or. &
  4221)             patch%imat(ghosted_id_dn) <= 0) cycle
  4222)       endif
  4223) 
  4224)       local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
  4225)       local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping   
  4226)      ! natural_id_up = grid%nG2N(ghosted_id_up)
  4227)      ! natural_id_dn = grid%nG2N(ghosted_id_dn)
  4228)    
  4229)       fraction_upwind = cur_connection_set%dist(-1,iconn)
  4230)       distance = cur_connection_set%dist(0,iconn)
  4231)       ! distance = scalar - magnitude of distance
  4232)       ! gravity = vector(3)
  4233)       ! dist(1:3,iconn) = vector(3) - unit vector
  4234)       distance_gravity = distance * &
  4235)                          dot_product(option%gravity, &
  4236)                                      cur_connection_set%dist(1:3,iconn))
  4237)       dd_up = distance*fraction_upwind
  4238)       dd_dn = distance-dd_up ! should avoid truncation error
  4239)       ! upweight could be calculated as 1.d0-fraction_upwind
  4240)       ! however, this introduces ever so slight error causing pflow-overhaul not
  4241)       ! to match pflow-orig.  This can be changed to 1.d0-fraction_upwind
  4242)       upweight = dd_dn/(dd_up+dd_dn)
  4243)     
  4244)       ! for now, just assume diagonal tensor
  4245)       call material_auxvars(ghosted_id_up)%PermeabilityTensorToScalar( &
  4246)                             cur_connection_set%dist(:,iconn),perm_up)
  4247)       call material_auxvars(ghosted_id_dn)%PermeabilityTensorToScalar( &
  4248)                             cur_connection_set%dist(:,iconn),perm_dn)
  4249)     
  4250) !     iphas_up = iphase_loc_p(ghosted_id_up)
  4251) !     iphas_dn = iphase_loc_p(ghosted_id_dn)
  4252) 
  4253)       ithrm_up = int(ithrm_loc_p(ghosted_id_up))
  4254)       ithrm_dn = int(ithrm_loc_p(ghosted_id_dn))
  4255)       D_up = Flash2_parameter%ckwet(ithrm_up)
  4256)       D_dn = Flash2_parameter%ckwet(ithrm_dn)
  4257)     
  4258)       icap_up = int(icap_loc_p(ghosted_id_up))
  4259)       icap_dn = int(icap_loc_p(ghosted_id_dn))
  4260)       
  4261)       do nvar = 1, option%nflowdof 
  4262)         call Flash2Flux(auxvars(ghosted_id_up)%auxvar_elem(nvar), &
  4263)                          material_auxvars(ghosted_id_up)%porosity, &
  4264)                          material_auxvars(ghosted_id_up)%tortuosity, &
  4265)                          Flash2_parameter%sir(:,icap_up), &
  4266)                          dd_up,perm_up,D_up, &
  4267)                          auxvars(ghosted_id_dn)%auxvar_elem(0), &
  4268)                          material_auxvars(ghosted_id_dn)%porosity, &
  4269)                          material_auxvars(ghosted_id_dn)%tortuosity, &
  4270)                          Flash2_parameter%sir(:,icap_dn), &
  4271)                          dd_dn,perm_dn,D_dn, &
  4272)                          cur_connection_set%area(iconn),distance_gravity, &
  4273)                          upweight, option, vv_darcy, Res)
  4274)         ra(:,nvar) = (Res(:)-patch%aux%Flash2%ResOld_FL(iconn,:))&
  4275)               /patch%aux%Flash2%delx(nvar,ghosted_id_up)
  4276)         call Flash2Flux(auxvars(ghosted_id_up)%auxvar_elem(0), &
  4277)                          material_auxvars(ghosted_id_up)%porosity, &
  4278)                          material_auxvars(ghosted_id_up)%tortuosity, &
  4279)                          Flash2_parameter%sir(:,icap_up), &
  4280)                          dd_up,perm_up,D_up, &
  4281)                          auxvars(ghosted_id_dn)%auxvar_elem(nvar), &
  4282)                          material_auxvars(ghosted_id_dn)%porosity, &
  4283)                          material_auxvars(ghosted_id_dn)%tortuosity, &
  4284)                          Flash2_parameter%sir(:,icap_dn), &
  4285)                          dd_dn,perm_dn,D_dn, &
  4286)                          cur_connection_set%area(iconn),distance_gravity, &
  4287)                          upweight, option, vv_darcy, Res)
  4288)         ra(:,nvar+option%nflowdof)= (Res(:)-patch%aux%Flash2%ResOld_FL(iconn,:))&
  4289)            /patch%aux%Flash2%delx(nvar,ghosted_id_dn)
  4290)       enddo
  4291) 
  4292)       select case(option%idt_switch)
  4293)       case(1)
  4294)         ra = ra / option%flow_dt
  4295)       case(-1)
  4296)        if (option%flow_dt>1) ra =ra / option%flow_dt
  4297)       end select
  4298)     
  4299)       if (local_id_up > 0) then
  4300)         voltemp=1.D0
  4301)         if (material_auxvars(ghosted_id_up)%volume > 1.D0)then
  4302)           voltemp = 1.D0/material_auxvars(ghosted_id_up)%volume
  4303)         endif
  4304)         Jup(:,1:option%nflowdof) = ra(:,1:option%nflowdof)*voltemp !11
  4305)         jdn(:,1:option%nflowdof) = ra(:, 1 + option%nflowdof:2 * option%nflowdof)*voltemp !12
  4306) 
  4307)         call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_up-1, &
  4308)             Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
  4309)         call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_dn-1, &
  4310)             Jdn,ADD_VALUES,ierr);CHKERRQ(ierr)
  4311)       endif
  4312)       if (local_id_dn > 0) then
  4313)         voltemp = 1.D0
  4314)         if (material_auxvars(ghosted_id_dn)%volume>1.D0) then
  4315)           voltemp = 1.D0/material_auxvars(ghosted_id_dn)%volume
  4316)         endif
  4317)         Jup(:,1:option%nflowdof) = -ra(:,1:option%nflowdof)*voltemp !21
  4318)         jdn(:,1:option%nflowdof) = -ra(:, 1 + option%nflowdof:2 * option%nflowdof)*voltemp !22
  4319) 
  4320)  
  4321)         call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_dn-1, &
  4322)             Jdn,ADD_VALUES,ierr);CHKERRQ(ierr)
  4323)         call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_up-1, &
  4324)             Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
  4325)       endif
  4326)     enddo
  4327)     cur_connection_set => cur_connection_set%next
  4328)   enddo
  4329) #endif
  4330)   if (realization%debug%matview_Jacobian_detailed) then
  4331)  ! print *,'end inter flux'
  4332)     call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  4333)     call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  4334)     string = 'jacobian_flux'
  4335)     call DebugCreateViewer(realization%debug,string,option,viewer)
  4336)     call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRQ(ierr)
  4337)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  4338)   endif
  4339)   
  4340)   call VecRestoreArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
  4341)   call VecRestoreArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
  4342)   call VecRestoreArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
  4343) 
  4344) end subroutine Flash2JacobianPatch1
  4345) 
  4346) ! ************************************************************************** !
  4347) 
  4348) subroutine Flash2JacobianPatch2(snes,xx,A,B,realization,ierr)
  4349)   ! 
  4350)   ! Flash2JacobianPatch: Computes the Jacobian: Accum, source, reaction
  4351)   ! 
  4352)   ! Author: Chuan Lu
  4353)   ! Date: 10/13/08
  4354)   ! 
  4355) 
  4356)   use Connection_module
  4357)   use Option_module
  4358)   use Grid_module
  4359)   use Realization_Subsurface_class
  4360)   use Patch_module
  4361)   use Coupler_module
  4362)   use Field_module
  4363)   use Debug_module
  4364)   use Material_Aux_class
  4365)   
  4366)   implicit none
  4367) 
  4368)   SNES :: snes
  4369)   Vec :: xx
  4370)   Mat :: A, B
  4371)   type(realization_subsurface_type) :: realization
  4372) 
  4373)   PetscErrorCode :: ierr
  4374)   PetscInt :: nvar,neq,nr
  4375)   PetscInt :: ithrm_up, ithrm_dn, i
  4376)   PetscInt :: ip1, ip2 
  4377) 
  4378)   PetscReal, pointer :: xx_loc_p(:), tortuosity_loc_p(:)
  4379)   PetscReal, pointer :: iphase_loc_p(:), icap_loc_p(:), ithrm_loc_p(:)
  4380)   PetscInt :: icap,iphas,iphas_up,iphas_dn,icap_up,icap_dn
  4381)   PetscInt :: ii, jj
  4382)   PetscReal :: dw_kg,dw_mol,enth_src_co2,enth_src_h2o,rho
  4383)   PetscReal :: tsrc1,qsrc1,csrc1,hsrc1
  4384)   PetscReal :: dd_up, dd_dn, dd, f_up, f_dn
  4385)   PetscReal :: perm_up, perm_dn
  4386)   PetscReal :: dw_dp,dw_dt,hw_dp,hw_dt,dresT_dp,dresT_dt
  4387)   PetscReal :: D_up, D_dn  ! "Diffusion" constants upstream and downstream of a face.
  4388)   PetscReal :: zero, norm
  4389)   PetscReal :: upweight
  4390)   PetscReal :: max_dev  
  4391)   PetscInt :: local_id, ghosted_id
  4392)   PetscInt :: local_id_up, local_id_dn
  4393)   PetscInt :: ghosted_id_up, ghosted_id_dn
  4394)   PetscInt ::  natural_id_up,natural_id_dn
  4395)   
  4396)   PetscReal :: Jup(1:realization%option%nflowdof,1:realization%option%nflowdof), &
  4397)             Jdn(1:realization%option%nflowdof,1:realization%option%nflowdof)
  4398)   
  4399)   PetscInt :: istart, iend
  4400)   
  4401)   type(coupler_type), pointer :: boundary_condition, source_sink
  4402)   type(connection_set_list_type), pointer :: connection_set_list
  4403)   type(connection_set_type), pointer :: cur_connection_set
  4404)   PetscBool :: enthalpy_flag
  4405)   PetscInt :: iconn, idof
  4406)   PetscInt :: sum_connection  
  4407)   PetscReal :: distance, fraction_upwind
  4408)   PetscReal :: distance_gravity
  4409)   PetscReal :: Res(realization%option%nflowdof) 
  4410)   PetscReal :: xxbc(1:realization%option%nflowdof), delxbc(1:realization%option%nflowdof)
  4411)   PetscReal :: ResInc(realization%patch%grid%nlmax,realization%option%nflowdof,&
  4412)            realization%option%nflowdof)
  4413)   type(grid_type), pointer :: grid
  4414)   type(patch_type), pointer :: patch
  4415)   type(option_type), pointer :: option 
  4416)   type(field_type), pointer :: field 
  4417)   type(Flash2_parameter_type), pointer :: Flash2_parameter
  4418)   type(Flash2_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
  4419)   type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
  4420)   class(material_auxvar_type), pointer :: material_auxvars(:)
  4421)   
  4422)   PetscReal :: vv_darcy(realization%option%nphase), voltemp
  4423)   PetscReal :: ra(1:realization%option%nflowdof,1:realization%option%nflowdof*2) 
  4424)   PetscReal, pointer :: msrc(:)
  4425)   PetscReal :: psrc(1:realization%option%nphase), ss_flow(1:realization%option%nphase)
  4426)   PetscReal :: dddt, dddp, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt,&
  4427)                dvdp, xphi
  4428)   PetscInt :: nsrcpara, flow_pc                
  4429)   
  4430)   PetscViewer :: viewer
  4431)   Vec :: debug_vec
  4432)   character(len=MAXSTRINGLENGTH) :: string
  4433) 
  4434) !-----------------------------------------------------------------------
  4435) ! R stand for residual
  4436) !  ra       1              2              3              4          5              6            7      8
  4437) ! 1: p     dR/dpi         dR/dTi          dR/dci        dR/dsi   dR/dpim        dR/dTim
  4438) ! 2: T
  4439) ! 3: c
  4440) ! 4  s         
  4441) !-----------------------------------------------------------------------
  4442) 
  4443)   patch => realization%patch
  4444)   grid => patch%grid
  4445)   option => realization%option
  4446)   field => realization%field
  4447) 
  4448)   Flash2_parameter => patch%aux%Flash2%Flash2_parameter
  4449)   auxvars => patch%aux%Flash2%auxvars
  4450)   auxvars_bc => patch%aux%Flash2%auxvars_bc
  4451)   global_auxvars => patch%aux%Global%auxvars
  4452)   global_auxvars_bc => patch%aux%Global%auxvars_bc
  4453)   material_auxvars => patch%aux%Material%auxvars
  4454)   
  4455) ! dropped derivatives:
  4456) !   1.D0 gas phase viscocity to all p,t,c,s
  4457) !   2. Average molecular weights to p,t,s
  4458) !  flag = SAME_NONZERO_PATTERN
  4459) 
  4460) #if 0
  4461) !  call Flash2NumericalJacobianTest(xx,realization)
  4462) #endif
  4463) 
  4464)  ! print *,'*********** In Jacobian ********************** '
  4465) !  call MatZeroEntries(A,ierr)
  4466) 
  4467)   call VecGetArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
  4468)   call VecGetArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
  4469) !  call VecGetArrayF90(field%iphas_loc, iphase_loc_p, ierr)
  4470) 
  4471)  ResInc = 0.D0
  4472) #if 1
  4473)   ! Accumulation terms ------------------------------------
  4474)   do local_id = 1, grid%nlmax  ! For each local node do...
  4475)     ghosted_id = grid%nL2G(local_id)
  4476)     !geh - Ignore inactive cells with inactive materials
  4477)     if (associated(patch%imat)) then
  4478)       if (patch%imat(ghosted_id) <= 0) cycle
  4479)     endif
  4480)     iend = local_id*option%nflowdof
  4481)     istart = iend-option%nflowdof+1
  4482)     icap = int(icap_loc_p(ghosted_id))
  4483)      
  4484)     do nvar =1, option%nflowdof
  4485)       call Flash2Accumulation(auxvars(ghosted_id)%auxvar_elem(nvar), &
  4486)              global_auxvars(ghosted_id),& 
  4487)              material_auxvars(ghosted_id)%porosity, &
  4488)              material_auxvars(ghosted_id)%volume, &
  4489)              Flash2_parameter%dencpr(int(ithrm_loc_p(ghosted_id))), &
  4490)              option,ONE_INTEGER, res) 
  4491)       ResInc( local_id,:,nvar) =  ResInc(local_id,:,nvar) + Res(:)
  4492)     enddo
  4493)   enddo
  4494) #endif
  4495) #if 1
  4496)   ! Source/sink terms -------------------------------------
  4497)   source_sink => patch%source_sink_list%first
  4498)   sum_connection = 0 
  4499)   do 
  4500)     if (.not.associated(source_sink)) exit
  4501)     
  4502)     ! check whether enthalpy dof is included
  4503)   !  if (source_sink%flow_condition%num_sub_conditions > 3) then
  4504)       enthalpy_flag = PETSC_TRUE
  4505)    ! else
  4506)    !   enthalpy_flag = PETSC_FALSE
  4507)    ! endif
  4508) 
  4509)     if (associated(source_sink%flow_condition%pressure)) then
  4510)       psrc(:) = source_sink%flow_condition%pressure%dataset%rarray(:)
  4511)     endif
  4512)     tsrc1 = source_sink%flow_condition%temperature%dataset%rarray(1)
  4513)     csrc1 = source_sink%flow_condition%concentration%dataset%rarray(1)
  4514)  !   hsrc1=0.D0
  4515)     if (enthalpy_flag) hsrc1 = source_sink%flow_condition%enthalpy%dataset%rarray(1)
  4516) 
  4517)    ! qsrc1 = qsrc1 / FMWH2O ! [kg/s -> kmol/s; fmw -> g/mol = kg/kmol]
  4518)    ! csrc1 = csrc1 / FMWCO2
  4519)     select case(source_sink%flow_condition%itype(1))
  4520)       case(MASS_RATE_SS)
  4521)         msrc => source_sink%flow_condition%rate%dataset%rarray
  4522)         nsrcpara= 2
  4523)       case(WELL_SS)
  4524)         msrc => source_sink%flow_condition%well%dataset%rarray
  4525)         nsrcpara = 7 + option%nflowspec 
  4526)       case default
  4527)         print *, 'Flash mode does not support source/sink type: ', source_sink%flow_condition%itype(1)
  4528)         stop  
  4529)     end select
  4530)     cur_connection_set => source_sink%connection_set
  4531)  
  4532)     do iconn = 1, cur_connection_set%num_connections      
  4533)       local_id = cur_connection_set%id_dn(iconn)
  4534)       ghosted_id = grid%nL2G(local_id)
  4535) 
  4536)       if (associated(patch%imat)) then
  4537)         if (patch%imat(ghosted_id) <= 0) cycle
  4538)       endif
  4539) !      if (enthalpy_flag) then
  4540) !        r_p(local_id*option%nflowdof) = r_p(local_id*option%nflowdof) - hsrc1 * option%flow_dt   
  4541) !      endif         
  4542)      do nvar =1, option%nflowdof
  4543)        call Flash2SourceSink(msrc,nsrcpara,psrc,tsrc1,hsrc1,csrc1, auxvars(ghosted_id)%auxvar_elem(nvar),&
  4544)                             source_sink%flow_condition%itype(1), Res,&
  4545)                             ss_flow, &
  4546)                             enthalpy_flag, option)
  4547) 
  4548)        ResInc(local_id,jh2o,nvar)=  ResInc(local_id,jh2o,nvar) - Res(jh2o)
  4549)        ResInc(local_id,jco2,nvar)=  ResInc(local_id,jco2,nvar) - Res(jco2)
  4550)        if (enthalpy_flag) & 
  4551)            ResInc(local_id,option%nflowdof,nvar)=&
  4552)            ResInc(local_id,option%nflowdof,nvar)- Res(option%nflowdof) 
  4553) 
  4554)       enddo
  4555)     enddo
  4556)     source_sink => source_sink%next
  4557)   enddo
  4558) #endif
  4559) 
  4560) ! Set matrix values related to single node terms: Accumulation, Source/Sink, BC
  4561)   do local_id = 1, grid%nlmax  ! For each local node do...
  4562)     ghosted_id = grid%nL2G(local_id)
  4563)     !geh - Ignore inactive cells with inactive materials
  4564)     if (associated(patch%imat)) then
  4565)       if (patch%imat(ghosted_id) <= 0) cycle
  4566)     endif
  4567) 
  4568)     ra=0.D0
  4569)     max_dev=0.D0
  4570)     do neq=1, option%nflowdof
  4571)       do nvar=1, option%nflowdof
  4572)         ra(neq,nvar)=(ResInc(local_id,neq,nvar)-patch%aux%Flash2%ResOld_AR(local_id,neq))&
  4573)               /patch%aux%Flash2%delx(nvar,ghosted_id)
  4574)         if (max_dev < dabs(ra(3,nvar))) max_dev = dabs(ra(3,nvar))
  4575)       enddo
  4576)     enddo
  4577)    
  4578)     select case(option%idt_switch)
  4579)     case(1)
  4580)       ra(1:option%nflowdof,1:option%nflowdof) = &
  4581)         ra(1:option%nflowdof,1:option%nflowdof) /option%flow_dt
  4582)     case(-1)
  4583)       if (option%flow_dt>1) ra(1:option%nflowdof,1:option%nflowdof) = &
  4584)         ra(1:option%nflowdof,1:option%nflowdof) /option%flow_dt
  4585)     end select
  4586) 
  4587)     Jup=ra(1:option%nflowdof,1:option%nflowdof)
  4588)     if (material_auxvars(ghosted_id)%volume > 1.D0) &
  4589)       Jup=Jup / material_auxvars(ghosted_id)%volume
  4590)    
  4591) !      if (local_id==1) print *, 'flash jac', volume_p(local_id), ra
  4592)     call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jup,ADD_VALUES, &
  4593)                                   ierr);CHKERRQ(ierr)
  4594)   end do
  4595) 
  4596)   if (realization%debug%matview_Jacobian_detailed) then
  4597)     call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  4598)     call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  4599)     string = 'jacobian_srcsink'
  4600)     call DebugCreateViewer(realization%debug,string,option,viewer)
  4601)     call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRQ(ierr)
  4602)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  4603)   endif
  4604)   
  4605)   call VecRestoreArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
  4606)   call VecRestoreArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
  4607) ! call VecRestoreArrayF90(field%iphas_loc, iphase_loc_p, ierr)
  4608) ! print *,'end jac'
  4609)   call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  4610)   call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  4611)  ! call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr)
  4612) #if 0
  4613) ! zero out isothermal and inactive cells
  4614) #ifdef ISOTHERMAL
  4615)   zero = 0.d0
  4616)   call MatZeroRowsLocal(A,n_zero_rows,zero_rows_local_ghosted,zero, &
  4617)                         PETSC_NULL_OBJECT,PETSC_NULL_OBJECT, &
  4618)                         ierr);CHKERRQ(ierr)
  4619)   do i=1, n_zero_rows
  4620)     ii = mod(zero_rows_local(i),option%nflowdof)
  4621)     ip1 = zero_rows_local_ghosted(i)
  4622)     if (ii == 0) then
  4623)       ip2 = ip1-1
  4624)     elseif (ii == option%nflowdof-1) then
  4625)       ip2 = ip1+1
  4626)     else
  4627)       ip2 = ip1
  4628)     endif
  4629)     call MatSetValuesLocal(A,1,ip1,1,ip2,1.d0,INSERT_VALUES, &
  4630)                            ierr);CHKERRQ(ierr)
  4631)   enddo
  4632) 
  4633)   call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  4634)   call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  4635) #else
  4636) #endif
  4637) #endif
  4638) 
  4639)   if (patch%aux%Flash2%inactive_cells_exist) then
  4640)     f_up = 1.d0
  4641)     call MatZeroRowsLocal(A,patch%aux%Flash2%n_zero_rows, &
  4642)                           patch%aux%Flash2%zero_rows_local_ghosted,f_up, &
  4643)                           PETSC_NULL_OBJECT,PETSC_NULL_OBJECT, &
  4644)                           ierr);CHKERRQ(ierr)
  4645)   endif
  4646) 
  4647)   if (realization%debug%matview_Jacobian) then
  4648)     string = 'Fjacobian'
  4649)     call DebugCreateViewer(realization%debug,string,option,viewer)
  4650)     call MatView(A,viewer,ierr);CHKERRQ(ierr)
  4651)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  4652)   endif
  4653)   if (realization%debug%norm_Jacobian) then
  4654)     call MatNorm(A,NORM_1,norm,ierr);CHKERRQ(ierr)
  4655)     write(option%io_buffer,'("1 norm: ",es11.4)') norm
  4656)     call printMsg(option)
  4657)     call MatNorm(A,NORM_FROBENIUS,norm,ierr);CHKERRQ(ierr)
  4658)     write(option%io_buffer,'("2 norm: ",es11.4)') norm
  4659)     call printMsg(option)
  4660)     call MatNorm(A,NORM_INFINITY,norm,ierr);CHKERRQ(ierr)
  4661)     write(option%io_buffer,'("inf norm: ",es11.4)') norm
  4662)     call printMsg(option)
  4663) !    call GridCreateVector(grid,ONEDOF,debug_vec,GLOBAL)
  4664) !    call MatGetRowMaxAbs(A,debug_vec,PETSC_NULL_INTEGER,ierr)
  4665) !    call VecMax(debug_vec,i,norm,ierr)
  4666) !    call VecDestroy(debug_vec,ierr)
  4667)   endif
  4668) 
  4669) end subroutine Flash2JacobianPatch2
  4670) 
  4671) ! ************************************************************************** !
  4672) 
  4673) subroutine Flash2MaxChange(realization,dpmax,dtmpmax,dsmax)
  4674)   ! 
  4675)   ! Computes the maximum change in the solution vector
  4676)   ! 
  4677)   ! Author: Chuan Lu
  4678)   ! Date: 01/15/08
  4679)   ! 
  4680) 
  4681)   use Realization_Subsurface_class
  4682)   use Field_module
  4683)   use Option_module
  4684)   use Field_module
  4685) 
  4686)   implicit none
  4687)   
  4688)   type(realization_subsurface_type) :: realization
  4689) 
  4690)   type(option_type), pointer :: option
  4691)   type(field_type), pointer :: field
  4692)   PetscErrorCode :: ierr 
  4693)   
  4694)   PetscReal :: dpmax, dtmpmax, dsmax 
  4695) 
  4696)   option => realization%option
  4697)   field => realization%field
  4698) 
  4699)   dpmax = 0.d0
  4700)   dtmpmax = 0.d0
  4701)   dsmax = 0.d0
  4702) 
  4703)   call VecWAXPY(field%flow_dxx,-1.d0,field%flow_xx,field%flow_yy, &
  4704)                 ierr);CHKERRQ(ierr)
  4705)   call VecStrideNorm(field%flow_dxx,ZERO_INTEGER,NORM_INFINITY,dpmax, &
  4706)                      ierr);CHKERRQ(ierr)
  4707)   call VecStrideNorm(field%flow_dxx,ONE_INTEGER,NORM_INFINITY,dtmpmax, &
  4708)                      ierr);CHKERRQ(ierr)
  4709)   call VecStrideNorm(field%flow_dxx,TWO_INTEGER,NORM_INFINITY,dsmax, &
  4710)                      ierr);CHKERRQ(ierr)
  4711) 
  4712) end subroutine Flash2MaxChange
  4713) 
  4714) ! ************************************************************************** !
  4715) 
  4716) function Flash2GetTecplotHeader(realization, icolumn)
  4717)   ! 
  4718)   ! Returns Richards contribution to
  4719)   ! Tecplot file header
  4720)   ! 
  4721)   ! Author: Chuan Lu
  4722)   ! Date: 10/13/08
  4723)   ! 
  4724) 
  4725)   use Realization_Subsurface_class
  4726)   use Option_module
  4727)   use Field_module
  4728) 
  4729)   implicit none
  4730)   
  4731)   character(len=MAXSTRINGLENGTH) :: Flash2GetTecplotHeader
  4732)   type(realization_subsurface_type) :: realization
  4733)   PetscInt :: icolumn
  4734)   
  4735)   character(len=MAXSTRINGLENGTH) :: string, string2
  4736)   type(option_type), pointer :: option
  4737)   type(field_type), pointer :: field  
  4738)   PetscInt :: i
  4739)   
  4740)   option => realization%option
  4741)   field => realization%field
  4742)   
  4743)   string = ''
  4744) 
  4745)   if (icolumn > -1) then
  4746)     icolumn = icolumn + 1
  4747)     write(string2,'('',"'',i2,''-T [C]"'')') icolumn
  4748)   else
  4749)     write(string2,'('',"T [C]"'')')
  4750)   endif
  4751)   string = trim(string) // trim(string2)
  4752)   
  4753)   if (icolumn > -1) then
  4754)     icolumn = icolumn + 1
  4755)     write(string2,'('',"'',i2,''-P [Pa]"'')') icolumn
  4756)   else
  4757)     write(string2,'('',"P [Pa]"'')')
  4758)   endif
  4759)   string = trim(string) // trim(string2)
  4760)   
  4761)   if (icolumn > -1) then
  4762)     icolumn = icolumn + 1
  4763)     write(string2,'('',"'',i2,''-PHASE"'')') icolumn
  4764)   else
  4765)     write(string2,'('',"PHASE"'')')
  4766)   endif
  4767)   string = trim(string) // trim(string2)
  4768)   
  4769)   if (icolumn > -1) then
  4770)     icolumn = icolumn + 1
  4771)     write(string2,'('',"'',i2,''-S(l)"'')') icolumn
  4772)   else
  4773)     write(string2,'('',"S(l)"'')')
  4774)   endif
  4775)   string = trim(string) // trim(string2)
  4776) 
  4777)   if (icolumn > -1) then
  4778)     icolumn = icolumn + 1
  4779)     write(string2,'('',"'',i2,''-S(g)"'')') icolumn
  4780)   else
  4781)     write(string2,'('',"S(g)"'')')
  4782)   endif
  4783)   string = trim(string) // trim(string2)
  4784)     
  4785)   if (icolumn > -1) then
  4786)     icolumn = icolumn + 1
  4787)     write(string2,'('',"'',i2,''-d(l)"'')') icolumn
  4788)   else
  4789)     write(string2,'('',"d(l)"'')')
  4790)   endif
  4791)   string = trim(string) // trim(string2)
  4792) 
  4793)   if (icolumn > -1) then
  4794)     icolumn = icolumn + 1
  4795)     write(string2,'('',"'',i2,''-d(g)"'')') icolumn
  4796)   else
  4797)     write(string2,'('',"d(g)"'')')
  4798)   endif
  4799)   string = trim(string) // trim(string2)
  4800)     
  4801)   if (icolumn > -1) then
  4802)     icolumn = icolumn + 1
  4803)     write(string2,'('',"'',i2,''-vis(l)"'')') icolumn
  4804)   else
  4805)     write(string2,'('',"vis(l)"'')')
  4806)   endif
  4807)   string = trim(string) // trim(string2)
  4808) 
  4809)   if (icolumn > -1) then
  4810)     icolumn = icolumn + 1
  4811)     write(string2,'('',"'',i2,''-vis(g)"'')') icolumn
  4812)   else
  4813)     write(string2,'('',"vis(g)"'')')
  4814)   endif
  4815)   string = trim(string) // trim(string2)
  4816)     
  4817)   if (icolumn > -1) then
  4818)     icolumn = icolumn + 1
  4819)     write(string2,'('',"'',i2,''-kvr(l)"'')') icolumn
  4820)   else
  4821)     write(string2,'('',"kvr(l)"'')')
  4822)   endif
  4823)   string = trim(string) // trim(string2)
  4824) 
  4825)   if (icolumn > -1) then
  4826)     icolumn = icolumn + 1
  4827)     write(string2,'('',"'',i2,''-kvr(g)"'')') icolumn
  4828)   else
  4829)     write(string2,'('',"kvr(g)"'')')
  4830)   endif
  4831)   string = trim(string) // trim(string2)
  4832)     
  4833)   if (icolumn > -1) then
  4834)     icolumn = icolumn + 1
  4835)     write(string2,'('',"'',i2,''-u(l)"'')') icolumn
  4836)   else
  4837)     write(string2,'('',"u(l)"'')')
  4838)   endif
  4839)   string = trim(string) // trim(string2)
  4840) 
  4841)   if (icolumn > -1) then
  4842)     icolumn = icolumn + 1
  4843)     write(string2,'('',"'',i2,''-u(g)"'')') icolumn
  4844)   else
  4845)     write(string2,'('',"u(g)"'')')
  4846)   endif
  4847)   string = trim(string) // trim(string2)
  4848)   do i=1,option%nflowspec
  4849)     if (icolumn > -1) then
  4850)       icolumn = icolumn + 1
  4851)       write(string2,'('',"'',i2,''-Xl('',i2,'')"'')') icolumn, i
  4852)     else
  4853)       write(string2,'('',"Xl('',i2,'')"'')') i
  4854)     endif
  4855)     string = trim(string) // trim(string2)
  4856)   enddo
  4857) 
  4858)   do i=1,option%nflowspec
  4859)     if (icolumn > -1) then
  4860)       icolumn = icolumn + 1
  4861)       write(string2,'('',"'',i2,''-Xg('',i2,'')"'')') icolumn, i
  4862)     else
  4863)       write(string2,'('',"Xg('',i2,'')"'')') i
  4864)     endif
  4865)     string = trim(string) // trim(string2)
  4866)   enddo
  4867) 
  4868)   Flash2GetTecplotHeader = string
  4869) 
  4870) end function Flash2GetTecplotHeader
  4871) 
  4872) ! ************************************************************************** !
  4873) 
  4874) subroutine Flash2SetPlotVariables(list)
  4875)   ! 
  4876)   ! Adds variables to be printed to list
  4877)   ! 
  4878)   ! Author: Glenn Hammond
  4879)   ! Date: 10/15/12
  4880)   ! 
  4881) 
  4882)   use Output_Aux_module
  4883)   use Variables_module
  4884)   
  4885)   implicit none
  4886) 
  4887)   type(output_variable_list_type), pointer :: list
  4888) 
  4889)   type(output_variable_type) :: output_variable
  4890)   character(len=MAXWORDLENGTH) :: name, units
  4891)   
  4892)   if (associated(list%first)) then
  4893)     return
  4894)   endif
  4895) 
  4896)   name = 'Temperature'
  4897)   units = 'C'
  4898)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  4899)                                TEMPERATURE)
  4900)   
  4901)   name = 'Liquid Pressure'
  4902)   units = 'Pa'
  4903)   call OutputVariableAddToList(list,name,OUTPUT_PRESSURE,units, &
  4904)                                LIQUID_PRESSURE)
  4905)   
  4906)   name = 'Gas Pressure'
  4907)   units = 'Pa'
  4908)   call OutputVariableAddToList(list,name,OUTPUT_PRESSURE,units, &
  4909)                                GAS_PRESSURE)
  4910) 
  4911)   name = 'Liquid Saturation'
  4912)   units = ''
  4913)   call OutputVariableAddToList(list,name,OUTPUT_SATURATION,units, &
  4914)                                LIQUID_SATURATION)
  4915) 
  4916)   name = 'Gas Saturation'
  4917)   units = ''
  4918)   call OutputVariableAddToList(list,name,OUTPUT_SATURATION,units, &
  4919)                                GAS_SATURATION)
  4920) 
  4921)   name = 'Liquid Density'
  4922)   units = 'kg/m^3'
  4923)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  4924)                                LIQUID_DENSITY)
  4925) 
  4926)   name = 'Gas Density'
  4927)   units = 'kg/m^3'
  4928)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  4929)                                GAS_DENSITY)
  4930) 
  4931)   name = 'Liquid Energy'
  4932)   units = 'kJ/mol'
  4933)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  4934)                                LIQUID_ENERGY)
  4935) 
  4936)   name = 'Gas Energy'
  4937)   units = 'kJ/mol'
  4938)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  4939)                                GAS_ENERGY)
  4940) 
  4941)   name = 'Liquid Viscosity'
  4942)   units = 'Pa.s'
  4943)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  4944)                                LIQUID_VISCOSITY)
  4945) 
  4946)   name = 'Gas Viscosity'
  4947)   units = 'Pa.s'
  4948)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  4949)                                GAS_VISCOSITY)
  4950) 
  4951)   name = 'Liquid Mobility'
  4952)   units = '1/Pa.s'
  4953)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  4954)                                LIQUID_MOBILITY)
  4955) 
  4956)   name = 'Gas Mobility'
  4957)   units = '1/Pa.s'
  4958)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  4959)                                GAS_MOBILITY)
  4960) 
  4961)   name = 'Liquid Mole Fraction H2O'
  4962)   units = ''
  4963)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  4964)                                LIQUID_MOLE_FRACTION,ONE_INTEGER)
  4965) 
  4966)   name = 'Liquid Mole Fraction CO2'
  4967)   units = ''
  4968)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  4969)                                LIQUID_MOLE_FRACTION,TWO_INTEGER)
  4970) 
  4971)   name = 'Gas Mole Fraction H2O'
  4972)   units = ''
  4973)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  4974)                                GAS_MOLE_FRACTION,ONE_INTEGER)
  4975) 
  4976)   name = 'Gas Mole Fraction CO2'
  4977)   units = ''
  4978)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  4979)                                GAS_MOLE_FRACTION,TWO_INTEGER)
  4980) 
  4981)   name = 'Phase'
  4982)   units = ''
  4983)   output_variable%iformat = 1 ! integer
  4984)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  4985)                                PHASE)
  4986) 
  4987) end subroutine Flash2SetPlotVariables
  4988) 
  4989) ! ************************************************************************** !
  4990) 
  4991) subroutine Flash2Destroy(realization)
  4992)   ! 
  4993)   ! Deallocates variables associated with Flash2
  4994)   ! 
  4995)   ! Author: Chuan Lu
  4996)   ! Date: 10/14/08
  4997)   ! 
  4998) 
  4999)   use Realization_Subsurface_class
  5000) 
  5001)   implicit none
  5002)   
  5003)   type(realization_subsurface_type) :: realization
  5004)   
  5005)   ! need to free array in aux vars
  5006)   !call Flash2AuxDestroy(patch%aux%Flash2)
  5007) 
  5008) end subroutine Flash2Destroy
  5009) 
  5010) 
  5011) #if 0
  5012) 
  5013) ! ************************************************************************** !
  5014) 
  5015) subroutine Flash2CheckpointWrite(discretization, viewer)
  5016)   ! 
  5017)   ! Writes vecs to checkpoint file
  5018)   ! date:
  5019)   ! 
  5020)   ! Author: Chuan Lu
  5021)   ! 
  5022) 
  5023)   use Discretization_module
  5024) 
  5025)   implicit none
  5026)   
  5027)   type(discretization_type) :: discretization
  5028)   PetscViewer :: viewer
  5029)   
  5030)   Vec :: global_var
  5031)   PetscErrorCode :: ierr
  5032)   
  5033)   call VecView(global_var,viewer,ierr);CHKERRQ(ierr)
  5034)   call VecDestroy(global_var,ierr);CHKERRQ(ierr)
  5035)   
  5036)   
  5037) end subroutine Flash2CheckpointWrite
  5038) 
  5039) ! ************************************************************************** !
  5040) 
  5041) subroutine Flash2CheckpointRead(discretization,viewer)
  5042)   ! 
  5043)   ! Reads vecs from checkpoint file
  5044)   ! date:
  5045)   ! 
  5046)   ! Author: Chuan Lu
  5047)   ! 
  5048) 
  5049)   use Discretization_module
  5050) 
  5051)   implicit none
  5052)   
  5053)   type(discretization_type) :: discretization
  5054)   PetscViewer :: viewer
  5055)   
  5056)   Vec :: global_var
  5057)   PetscErrorCode :: ierr
  5058)   
  5059)   call VecLoad(global_var, viewer, ierr);CHKERRQ(ierr)
  5060)   call VecDestroy(global_var,ierr);CHKERRQ(ierr)
  5061)   
  5062) end subroutine Flash2CheckpointRead
  5063) 
  5064) #endif
  5065) 
  5066) end module Flash2_module

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