general.F90       coverage:  81.48 %func     56.52 %block


     1) module General_module
     2) 
     3)   use General_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) #include "petsc/finclude/petscvec.h"
    14) #include "petsc/finclude/petscvec.h90"
    15) #include "petsc/finclude/petscmat.h"
    16) #include "petsc/finclude/petscmat.h90"
    17) #include "petsc/finclude/petscsnes.h"
    18) #include "petsc/finclude/petscviewer.h"
    19) #include "petsc/finclude/petsclog.h"
    20) 
    21) #define CONVECTION
    22) #define DIFFUSION
    23) #define LIQUID_DIFFUSION
    24) #define CONDUCTION
    25)   
    26) !#define DEBUG_GENERAL_FILEOUTPUT
    27) !#define DEBUG_FLUXES  
    28) 
    29) ! Cutoff parameters
    30)   PetscReal, parameter :: eps       = 1.d-8
    31)   PetscReal, parameter :: floweps   = 1.d-24
    32) 
    33) #ifdef DEBUG_GENERAL_FILEOUTPUT
    34)   PetscInt, parameter :: debug_unit = 87
    35)   PetscInt, parameter :: debug_info_unit = 86
    36)   character(len=MAXWORDLENGTH) :: debug_filename
    37)   PetscInt :: debug_flag = 0
    38)   PetscInt :: debug_iteration_count
    39)   PetscInt :: debug_timestep_cut_count
    40)   PetscInt :: debug_timestep_count
    41) #endif
    42) 
    43)   public :: GeneralSetup, &
    44)             GeneralInitializeTimestep, &
    45)             GeneralUpdateSolution, &
    46)             GeneralTimeCut,&
    47)             GeneralUpdateAuxVars, &
    48)             GeneralUpdateFixedAccum, &
    49)             GeneralComputeMassBalance, &
    50)             GeneralResidual, &
    51)             GeneralJacobian, &
    52)             GeneralGetTecplotHeader, &
    53)             GeneralSetPlotVariables, &
    54)             GeneralMapBCAuxVarsToGlobal, &
    55)             GeneralDestroy
    56) 
    57) contains
    58) 
    59) ! ************************************************************************** !
    60) 
    61) subroutine GeneralSetup(realization)
    62)   ! 
    63)   ! Creates arrays for auxiliary variables
    64)   ! 
    65)   ! Author: Glenn Hammond
    66)   ! Date: 03/10/11
    67)   ! 
    68) 
    69)   use Realization_Subsurface_class
    70)   use Patch_module
    71)   use Option_module
    72)   use Coupler_module
    73)   use Connection_module
    74)   use Grid_module
    75)   use Fluid_module
    76)   use Material_Aux_class
    77)   use Output_Aux_module
    78)  
    79)   implicit none
    80)   
    81)   type(realization_subsurface_type) :: realization
    82) 
    83)   type(option_type), pointer :: option
    84)   type(patch_type),pointer :: patch
    85)   type(grid_type), pointer :: grid
    86)   type(output_variable_list_type), pointer :: list
    87)   type(coupler_type), pointer :: boundary_condition
    88)   type(material_parameter_type), pointer :: material_parameter
    89) 
    90)   PetscInt :: ghosted_id, iconn, sum_connection, local_id
    91)   PetscInt :: i, idof, count
    92)   PetscBool :: error_found
    93)   PetscInt :: flag(10)
    94)                                                 ! extra index for derivatives
    95)   type(general_auxvar_type), pointer :: gen_auxvars(:,:)
    96)   type(general_auxvar_type), pointer :: gen_auxvars_bc(:)
    97)   type(general_auxvar_type), pointer :: gen_auxvars_ss(:)
    98)   class(material_auxvar_type), pointer :: material_auxvars(:)
    99)   type(fluid_property_type), pointer :: cur_fluid_property
   100)   
   101)   option => realization%option
   102)   patch => realization%patch
   103)   grid => patch%grid
   104)   
   105)   patch%aux%General => GeneralAuxCreate(option)
   106) 
   107)   ! ensure that material properties specific to this module are properly
   108)   ! initialized
   109)   material_parameter => patch%aux%Material%material_parameter
   110)   error_found = PETSC_FALSE
   111)   if (minval(material_parameter%soil_residual_saturation(:,:)) < 0.d0) then
   112)     option%io_buffer = 'Non-initialized soil residual saturation.'
   113)     call printMsg(option)
   114)     error_found = PETSC_TRUE
   115)   endif
   116)   if (minval(material_parameter%soil_heat_capacity(:)) < 0.d0) then
   117)     option%io_buffer = 'Non-initialized soil heat capacity.'
   118)     call printMsg(option)
   119)     error_found = PETSC_TRUE
   120)   endif
   121)   if (minval(material_parameter%soil_thermal_conductivity(:,:)) < 0.d0) then
   122)     option%io_buffer = 'Non-initialized soil thermal conductivity.'
   123)     call printMsg(option)
   124)     error_found = PETSC_TRUE
   125)   endif
   126)   
   127)   material_auxvars => patch%aux%Material%auxvars
   128)   flag = 0
   129)   !TODO(geh): change to looping over ghosted ids once the legacy code is 
   130)   !           history and the communicator can be passed down.
   131)   do local_id = 1, grid%nlmax
   132)     ghosted_id = grid%nL2G(local_id)
   133)     if (patch%imat(ghosted_id) <= 0) cycle
   134)     if (material_auxvars(ghosted_id)%volume < 0.d0 .and. flag(1) == 0) then
   135)       flag(1) = 1
   136)       option%io_buffer = 'Non-initialized cell volume.'
   137)       call printMsg(option)
   138)     endif
   139)     if (material_auxvars(ghosted_id)%porosity < 0.d0 .and. flag(2) == 0) then
   140)       flag(2) = 1
   141)       option%io_buffer = 'Non-initialized porosity.'
   142)       call printMsg(option)
   143)     endif
   144)     if (material_auxvars(ghosted_id)%tortuosity < 0.d0 .and. flag(3) == 0) then
   145)       flag(3) = 1
   146)       option%io_buffer = 'Non-initialized tortuosity.'
   147)       call printMsg(option)
   148)     endif
   149)     if (material_auxvars(ghosted_id)%soil_particle_density < 0.d0 .and. &
   150)         flag(4) == 0) then
   151)       flag(4) = 1
   152)       option%io_buffer = 'Non-initialized soil particle density.'
   153)       call printMsg(option)
   154)     endif
   155)     if (minval(material_auxvars(ghosted_id)%permeability) < 0.d0 .and. &
   156)         flag(5) == 0) then
   157)       option%io_buffer = 'Non-initialized permeability.'
   158)       call printMsg(option)
   159)       flag(5) = 1
   160)     endif
   161)   enddo
   162)   
   163)   if (error_found .or. maxval(flag) > 0) then
   164)     option%io_buffer = 'Material property errors found in GeneralSetup.'
   165)     call printErrMsg(option)
   166)   endif
   167)   
   168)   ! allocate auxvar data structures for all grid cells  
   169)   allocate(gen_auxvars(0:option%nflowdof,grid%ngmax))
   170)   do ghosted_id = 1, grid%ngmax
   171)     do idof = 0, option%nflowdof
   172)       call GeneralAuxVarInit(gen_auxvars(idof,ghosted_id), &
   173)                              (general_analytical_derivatives .and. idof==0), &
   174)                              option)
   175)     enddo
   176)   enddo
   177)   patch%aux%General%auxvars => gen_auxvars
   178)   patch%aux%General%num_aux = grid%ngmax
   179) 
   180)   ! count the number of boundary connections and allocate
   181)   ! auxvar data structures for them 
   182)   sum_connection = CouplerGetNumConnectionsInList(patch%boundary_condition_list)
   183)   if (sum_connection > 0) then
   184)     allocate(gen_auxvars_bc(sum_connection))
   185)     do iconn = 1, sum_connection
   186)       call GeneralAuxVarInit(gen_auxvars_bc(iconn),PETSC_FALSE,option)
   187)     enddo
   188)     patch%aux%General%auxvars_bc => gen_auxvars_bc
   189)   endif
   190)   patch%aux%General%num_aux_bc = sum_connection
   191) 
   192)   ! count the number of source/sink connections and allocate
   193)   ! auxvar data structures for them  
   194)   sum_connection = CouplerGetNumConnectionsInList(patch%source_sink_list)
   195)   if (sum_connection > 0) then
   196)     allocate(gen_auxvars_ss(sum_connection))
   197)     do iconn = 1, sum_connection
   198)       call GeneralAuxVarInit(gen_auxvars_ss(iconn),PETSC_FALSE,option)
   199)     enddo
   200)     patch%aux%General%auxvars_ss => gen_auxvars_ss
   201)   endif
   202)   patch%aux%General%num_aux_ss = sum_connection
   203) 
   204)   ! create array for zeroing Jacobian entries if isothermal and/or no air
   205)   allocate(patch%aux%General%row_zeroing_array(grid%nlmax))
   206)   patch%aux%General%row_zeroing_array = 0
   207)   
   208)   ! initialize parameters
   209)   cur_fluid_property => realization%fluid_properties
   210)   do 
   211)     if (.not.associated(cur_fluid_property)) exit
   212)     patch%aux%General%general_parameter% &
   213)       diffusion_coefficient(cur_fluid_property%phase_id) = &
   214)         cur_fluid_property%diffusion_coefficient
   215)     cur_fluid_property => cur_fluid_property%next
   216)   enddo  
   217)   ! check whether diffusion coefficients are initialized.
   218)   if (Uninitialized(patch%aux%General%general_parameter% &
   219)       diffusion_coefficient(LIQUID_PHASE))) then
   220)     option%io_buffer = &
   221)       UninitializedMessage('Liquid phase diffusion coefficient','')
   222)     call printErrMsg(option)
   223)   endif
   224)   if (Uninitialized(patch%aux%General%general_parameter% &
   225)       diffusion_coefficient(GAS_PHASE))) then
   226)     option%io_buffer = &
   227)       UninitializedMessage('Gas phase diffusion coefficient','')
   228)     call printErrMsg(option)
   229)   endif
   230) 
   231)   list => realization%output_option%output_snap_variable_list
   232)   call GeneralSetPlotVariables(realization,list)
   233)   list => realization%output_option%output_obs_variable_list
   234)   call GeneralSetPlotVariables(realization,list)
   235)   
   236) #ifdef DEBUG_GENERAL_FILEOUTPUT
   237)   debug_flag = 0
   238)   debug_iteration_count = 0
   239)   debug_timestep_cut_count = 0
   240)   debug_timestep_count = 0
   241)   ! create new file
   242)   open(debug_info_unit, file='debug_info.txt', action="write", &
   243)        status="unknown")
   244)   write(debug_info_unit,*) 'type timestep cut iteration'
   245)   close(debug_info_unit)
   246) #endif  
   247) 
   248) end subroutine GeneralSetup
   249) 
   250) ! ************************************************************************** !
   251) 
   252) subroutine GeneralInitializeTimestep(realization)
   253)   ! 
   254)   ! Update data in module prior to time step
   255)   ! 
   256)   ! Author: Glenn Hammond
   257)   ! Date: 03/10/11
   258)   ! 
   259) 
   260)   use Realization_Subsurface_class
   261)   
   262)   implicit none
   263)   
   264)   type(realization_subsurface_type) :: realization
   265) 
   266)   call GeneralUpdateFixedAccum(realization)
   267)   
   268) #ifdef DEBUG_GENERAL_FILEOUTPUT
   269)   debug_flag = 0
   270) !  if (realization%option%time >= 35.6d0*3600d0*24.d0*365.d0 - 1.d-40) then
   271) !  if (.false.) then
   272)   if (.true.) then
   273)     debug_iteration_count = 0
   274)     debug_flag = 1
   275)   endif
   276)   debug_iteration_count = 0
   277) #endif
   278) 
   279) end subroutine GeneralInitializeTimestep
   280) 
   281) ! ************************************************************************** !
   282) 
   283) subroutine GeneralUpdateSolution(realization)
   284)   ! 
   285)   ! Updates data in module after a successful time
   286)   ! step
   287)   ! 
   288)   ! Author: Glenn Hammond
   289)   ! Date: 03/10/11
   290)   ! 
   291) 
   292)   use Realization_Subsurface_class
   293)   use Field_module
   294)   use Patch_module
   295)   use Discretization_module
   296)   use Option_module
   297)   use Grid_module
   298)   
   299)   implicit none
   300)   
   301)   type(realization_subsurface_type) :: realization
   302) 
   303)   type(option_type), pointer :: option
   304)   type(patch_type), pointer :: patch
   305)   type(grid_type), pointer :: grid
   306)   type(field_type), pointer :: field
   307)   type(general_auxvar_type), pointer :: gen_auxvars(:,:)
   308)   type(global_auxvar_type), pointer :: global_auxvars(:)  
   309)   PetscInt :: local_id, ghosted_id
   310)   PetscErrorCode :: ierr
   311)   
   312)   option => realization%option
   313)   field => realization%field
   314)   patch => realization%patch
   315)   grid => patch%grid
   316)   gen_auxvars => patch%aux%General%auxvars  
   317)   global_auxvars => patch%aux%Global%auxvars
   318)   
   319)   if (realization%option%compute_mass_balance_new) then
   320)     call GeneralUpdateMassBalance(realization)
   321)   endif
   322)   
   323)   ! update stored state
   324)   do ghosted_id = 1, grid%ngmax
   325)     gen_auxvars(ZERO_INTEGER,ghosted_id)%istate_store(PREV_TS) = &
   326)       global_auxvars(ghosted_id)%istate
   327)   enddo
   328)   
   329) #ifdef DEBUG_GENERAL_FILEOUTPUT
   330)   debug_iteration_count = 0
   331)   debug_timestep_cut_count = 0
   332)   debug_timestep_count = debug_timestep_count + 1
   333) #endif   
   334)   
   335) end subroutine GeneralUpdateSolution
   336) 
   337) ! ************************************************************************** !
   338) 
   339) subroutine GeneralTimeCut(realization)
   340)   ! 
   341)   ! Resets arrays for time step cut
   342)   ! 
   343)   ! Author: Glenn Hammond
   344)   ! Date: 03/10/11
   345)   ! 
   346)   use Realization_Subsurface_class
   347)   use Option_module
   348)   use Field_module
   349)   use Patch_module
   350)   use Discretization_module
   351)   use Grid_module
   352)  
   353)   implicit none
   354)   
   355)   type(realization_subsurface_type) :: realization
   356)   type(option_type), pointer :: option
   357)   type(patch_type), pointer :: patch
   358)   type(grid_type), pointer :: grid
   359)   type(global_auxvar_type), pointer :: global_auxvars(:)  
   360)   type(general_auxvar_type), pointer :: gen_auxvars(:,:)
   361)   
   362)   PetscInt :: local_id, ghosted_id
   363)   PetscErrorCode :: ierr
   364) 
   365)   option => realization%option
   366)   patch => realization%patch
   367)   grid => patch%grid
   368)   global_auxvars => patch%aux%Global%auxvars
   369)   gen_auxvars => patch%aux%General%auxvars
   370) 
   371)   ! restore stored state
   372)   do ghosted_id = 1, grid%ngmax
   373)     global_auxvars(ghosted_id)%istate = &
   374)       gen_auxvars(ZERO_INTEGER,ghosted_id)%istate_store(PREV_TS)
   375)   enddo
   376) 
   377) #ifdef DEBUG_GENERAL_FILEOUTPUT
   378)   debug_timestep_cut_count = debug_timestep_cut_count + 1
   379) #endif 
   380) 
   381)   call GeneralInitializeTimestep(realization)  
   382) 
   383) end subroutine GeneralTimeCut
   384) 
   385) ! ************************************************************************** !
   386) 
   387) subroutine GeneralNumericalJacobianTest(xx,realization,B)
   388)   ! 
   389)   ! Computes the a test numerical jacobian
   390)   ! 
   391)   ! Author: Glenn Hammond
   392)   ! Date: 03/03/15
   393)   ! 
   394) 
   395)   use Realization_Subsurface_class
   396)   use Patch_module
   397)   use Option_module
   398)   use Grid_module
   399)   use Field_module
   400) 
   401)   implicit none
   402) 
   403)   Vec :: xx
   404)   type(realization_subsurface_type) :: realization
   405)   Mat :: B
   406) 
   407)   Vec :: xx_pert
   408)   Vec :: res
   409)   Vec :: res_pert
   410)   Mat :: A
   411)   PetscViewer :: viewer
   412)   PetscErrorCode :: ierr
   413) 
   414)   PetscReal, pointer :: vec_p(:), vec2_p(:)
   415) 
   416)   type(grid_type), pointer :: grid
   417)   type(option_type), pointer :: option
   418)   type(patch_type), pointer :: patch
   419)   type(field_type), pointer :: field
   420)   PetscReal :: derivative, perturbation
   421)   PetscReal :: perturbation_tolerance = 1.d-6
   422)   PetscInt, save :: icall = 0
   423)   character(len=MAXWORDLENGTH) :: word, word2
   424) 
   425)   PetscInt :: idof, idof2, icell
   426) 
   427)   patch => realization%patch
   428)   grid => patch%grid
   429)   option => realization%option
   430)   field => realization%field
   431) 
   432)   icall = icall + 1
   433)   call VecDuplicate(xx,xx_pert,ierr);CHKERRQ(ierr)
   434)   call VecDuplicate(xx,res,ierr);CHKERRQ(ierr)
   435)   call VecDuplicate(xx,res_pert,ierr);CHKERRQ(ierr)
   436) 
   437)   call MatCreate(option%mycomm,A,ierr);CHKERRQ(ierr)
   438)   call MatSetType(A,MATAIJ,ierr);CHKERRQ(ierr)
   439)   call MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,grid%nlmax*option%nflowdof, &
   440)                    grid%nlmax*option%nflowdof, &
   441)                    ierr);CHKERRQ(ierr)
   442)   call MatSeqAIJSetPreallocation(A,27,PETSC_NULL_INTEGER,ierr);CHKERRQ(ierr)
   443)   call MatSetFromOptions(A,ierr);CHKERRQ(ierr)
   444)   call MatSetOption(A,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE, &
   445)                     ierr);CHKERRQ(ierr)
   446) 
   447)   call VecZeroEntries(res,ierr);CHKERRQ(ierr)
   448)   call GeneralResidual(PETSC_NULL_OBJECT,xx,res,realization,ierr)
   449) #if 0
   450)   word  = 'num_0.dat'
   451)   call PetscViewerASCIIOpen(option%mycomm,word,viewer,ierr);CHKERRQ(ierr)
   452)   call VecView(res,viewer,ierr);CHKERRQ(ierr)
   453)   call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
   454) #endif
   455)   call VecGetArrayF90(res,vec2_p,ierr);CHKERRQ(ierr)
   456)   do icell = 1,grid%nlmax
   457)     if (patch%imat(grid%nL2G(icell)) <= 0) cycle
   458)     do idof = (icell-1)*option%nflowdof+1,icell*option%nflowdof 
   459)       call VecCopy(xx,xx_pert,ierr);CHKERRQ(ierr)
   460)       call VecGetArrayF90(xx_pert,vec_p,ierr);CHKERRQ(ierr)
   461)       perturbation = vec_p(idof)*perturbation_tolerance
   462)       vec_p(idof) = vec_p(idof)+perturbation
   463)       call VecRestoreArrayF90(xx_pert,vec_p,ierr);CHKERRQ(ierr)
   464)       call VecZeroEntries(res_pert,ierr);CHKERRQ(ierr)
   465)       call GeneralResidual(PETSC_NULL_OBJECT,xx_pert,res_pert,realization,ierr)
   466) #if 0
   467)       write(word,*) idof
   468)       word  = 'num_' // trim(adjustl(word)) // '.dat'
   469)       call PetscViewerASCIIOpen(option%mycomm,word,viewer,ierr);CHKERRQ(ierr)
   470)       call VecView(res_pert,viewer,ierr);CHKERRQ(ierr)
   471)       call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
   472) #endif
   473)       call VecGetArrayF90(res_pert,vec_p,ierr);CHKERRQ(ierr)
   474)       do idof2 = 1, grid%nlmax*option%nflowdof
   475)         derivative = (vec_p(idof2)-vec2_p(idof2))/perturbation
   476)         if (dabs(derivative) > 1.d-30) then
   477)           call MatSetValue(A,idof2-1,idof-1,derivative,INSERT_VALUES, &
   478)                            ierr);CHKERRQ(ierr)
   479)         endif
   480)       enddo
   481)       call VecRestoreArrayF90(res_pert,vec_p,ierr);CHKERRQ(ierr)
   482)     enddo
   483)   enddo
   484)   call VecRestoreArrayF90(res,vec2_p,ierr);CHKERRQ(ierr)
   485) 
   486)   call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
   487)   call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
   488) 
   489) #if 1
   490)   write(word,*) icall
   491)   word = 'numerical_jacobian-' // trim(adjustl(word)) // '.out'
   492)   call PetscViewerASCIIOpen(option%mycomm,word,viewer,ierr);CHKERRQ(ierr)
   493)   call MatView(A,viewer,ierr);CHKERRQ(ierr)
   494)   call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
   495) #endif
   496) 
   497) !geh: uncomment to overwrite numerical Jacobian
   498) !  call MatCopy(A,B,DIFFERENT_NONZERO_PATTERN,ierr)
   499)   call MatDestroy(A,ierr);CHKERRQ(ierr)
   500) 
   501)   call VecDestroy(xx_pert,ierr);CHKERRQ(ierr)
   502)   call VecDestroy(res,ierr);CHKERRQ(ierr)
   503)   call VecDestroy(res_pert,ierr);CHKERRQ(ierr)
   504) 
   505) end subroutine GeneralNumericalJacobianTest
   506) 
   507) ! ************************************************************************** !
   508) 
   509) subroutine GeneralComputeMassBalance(realization,mass_balance)
   510)   ! 
   511)   ! Initializes mass balance
   512)   ! 
   513)   ! Author: Glenn Hammond
   514)   ! Date: 03/10/11
   515)   ! 
   516)  
   517)   use Realization_Subsurface_class
   518)   use Option_module
   519)   use Patch_module
   520)   use Field_module
   521)   use Grid_module
   522)   use Material_Aux_class
   523)  
   524)   implicit none
   525)   
   526)   type(realization_subsurface_type) :: realization
   527)   PetscReal :: mass_balance(realization%option%nflowspec, &
   528)                             realization%option%nphase)
   529) 
   530)   type(option_type), pointer :: option
   531)   type(patch_type), pointer :: patch
   532)   type(field_type), pointer :: field
   533)   type(grid_type), pointer :: grid
   534)   type(general_auxvar_type), pointer :: general_auxvars(:,:)
   535)   class(material_auxvar_type), pointer :: material_auxvars(:)
   536) 
   537)   PetscErrorCode :: ierr
   538)   PetscInt :: local_id
   539)   PetscInt :: ghosted_id
   540)   PetscInt :: iphase, icomp
   541)   PetscReal :: vol_phase
   542) 
   543)   option => realization%option
   544)   patch => realization%patch
   545)   grid => patch%grid
   546)   field => realization%field
   547) 
   548)   general_auxvars => patch%aux%General%auxvars
   549)   material_auxvars => patch%aux%Material%auxvars
   550) 
   551)   mass_balance = 0.d0
   552) 
   553)   do local_id = 1, grid%nlmax
   554)     ghosted_id = grid%nL2G(local_id)
   555)     !geh - Ignore inactive cells with inactive materials
   556)     if (patch%imat(ghosted_id) <= 0) cycle
   557)     do iphase = 1, option%nphase
   558)       ! volume_phase = saturation*porosity*volume
   559)       vol_phase = &
   560)         general_auxvars(ZERO_INTEGER,ghosted_id)%sat(iphase)* &
   561)         general_auxvars(ZERO_INTEGER,ghosted_id)%effective_porosity* &
   562)         material_auxvars(ghosted_id)%volume
   563)       ! mass = volume_phase*density
   564)       do icomp = 1, option%nflowspec
   565)         mass_balance(icomp,iphase) = mass_balance(icomp,iphase) + &
   566)           general_auxvars(ZERO_INTEGER,ghosted_id)%den(iphase)* &
   567)           general_auxvars(ZERO_INTEGER,ghosted_id)%xmol(icomp,iphase) * &
   568)           fmw_comp(icomp)*vol_phase
   569)       enddo
   570)     enddo
   571)   enddo
   572) 
   573) end subroutine GeneralComputeMassBalance
   574) 
   575) ! ************************************************************************** !
   576) 
   577) subroutine GeneralZeroMassBalanceDelta(realization)
   578)   ! 
   579)   ! Zeros mass balance delta array
   580)   ! 
   581)   ! Author: Glenn Hammond
   582)   ! Date: 03/10/11
   583)   ! 
   584)  
   585)   use Realization_Subsurface_class
   586)   use Option_module
   587)   use Patch_module
   588)   use Grid_module
   589)  
   590)   implicit none
   591)   
   592)   type(realization_subsurface_type) :: realization
   593) 
   594)   type(option_type), pointer :: option
   595)   type(patch_type), pointer :: patch
   596)   type(global_auxvar_type), pointer :: global_auxvars_bc(:)
   597)   type(global_auxvar_type), pointer :: global_auxvars_ss(:)
   598) 
   599)   PetscInt :: iconn
   600) 
   601)   option => realization%option
   602)   patch => realization%patch
   603) 
   604)   global_auxvars_bc => patch%aux%Global%auxvars_bc
   605)   global_auxvars_ss => patch%aux%Global%auxvars_ss
   606) 
   607)   do iconn = 1, patch%aux%General%num_aux_bc
   608)     global_auxvars_bc(iconn)%mass_balance_delta = 0.d0
   609)   enddo
   610)   do iconn = 1, patch%aux%General%num_aux_ss
   611)     global_auxvars_ss(iconn)%mass_balance_delta = 0.d0
   612)   enddo
   613) 
   614) end subroutine GeneralZeroMassBalanceDelta
   615) 
   616) ! ************************************************************************** !
   617) 
   618) subroutine GeneralUpdateMassBalance(realization)
   619)   ! 
   620)   ! Updates mass balance
   621)   ! 
   622)   ! Author: Glenn Hammond
   623)   ! Date: 03/10/11
   624)   ! 
   625)  
   626)   use Realization_Subsurface_class
   627)   use Option_module
   628)   use Patch_module
   629)   use Grid_module
   630)  
   631)   implicit none
   632)   
   633)   type(realization_subsurface_type) :: realization
   634) 
   635)   type(option_type), pointer :: option
   636)   type(patch_type), pointer :: patch
   637)   type(global_auxvar_type), pointer :: global_auxvars_bc(:)
   638)   type(global_auxvar_type), pointer :: global_auxvars_ss(:)
   639)   
   640)   PetscInt :: iconn
   641)   PetscInt :: icomp
   642) 
   643)   option => realization%option
   644)   patch => realization%patch
   645) 
   646)   global_auxvars_bc => patch%aux%Global%auxvars_bc
   647)   global_auxvars_ss => patch%aux%Global%auxvars_ss
   648) 
   649)   do iconn = 1, patch%aux%General%num_aux_bc
   650)     do icomp = 1, option%nflowspec
   651)       global_auxvars_bc(iconn)%mass_balance(icomp,:) = &
   652)         global_auxvars_bc(iconn)%mass_balance(icomp,:) + &
   653)         global_auxvars_bc(iconn)%mass_balance_delta(icomp,:)* &
   654)         fmw_comp(icomp)*option%flow_dt
   655)     enddo
   656)   enddo
   657)   do iconn = 1, patch%aux%General%num_aux_ss
   658)     do icomp = 1, option%nflowspec
   659)       global_auxvars_ss(iconn)%mass_balance(icomp,:) = &
   660)         global_auxvars_ss(iconn)%mass_balance(icomp,:) + &
   661)         global_auxvars_ss(iconn)%mass_balance_delta(icomp,:)* &
   662)         fmw_comp(icomp)*option%flow_dt
   663)     enddo
   664)   enddo
   665) 
   666) end subroutine GeneralUpdateMassBalance
   667) 
   668) ! ************************************************************************** !
   669) 
   670) subroutine GeneralUpdateAuxVars(realization,update_state)
   671)   ! 
   672)   ! Updates the auxiliary variables associated with the General problem
   673)   ! 
   674)   ! Author: Glenn Hammond
   675)   ! Date: 03/10/11
   676)   ! 
   677) 
   678)   use Realization_Subsurface_class
   679)   use Patch_module
   680)   use Option_module
   681)   use Field_module
   682)   use Grid_module
   683)   use Coupler_module
   684)   use Connection_module
   685)   use Material_module
   686)   use Material_Aux_class
   687)   use EOS_Water_module
   688)   use Saturation_Function_module
   689)   
   690)   implicit none
   691) 
   692)   type(realization_subsurface_type) :: realization
   693)   PetscBool :: update_state
   694)   
   695)   type(option_type), pointer :: option
   696)   type(patch_type), pointer :: patch
   697)   type(grid_type), pointer :: grid
   698)   type(field_type), pointer :: field
   699)   type(coupler_type), pointer :: boundary_condition
   700)   type(connection_set_type), pointer :: cur_connection_set
   701)   type(general_auxvar_type), pointer :: gen_auxvars(:,:), gen_auxvars_bc(:)  
   702)   type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)  
   703)   class(material_auxvar_type), pointer :: material_auxvars(:)
   704) 
   705)   PetscInt :: ghosted_id, local_id, sum_connection, idof, iconn, natural_id
   706)   PetscInt :: ghosted_start, ghosted_end
   707)   PetscInt :: iphasebc, iphase
   708)   PetscInt :: offset
   709)   PetscInt :: istate
   710)   PetscReal :: gas_pressure, capillary_pressure, liquid_saturation
   711)   PetscReal :: saturation_pressure, temperature
   712)   PetscInt :: real_index, variable
   713)   PetscReal, pointer :: xx_loc_p(:)
   714)   PetscReal :: xxbc(realization%option%nflowdof)
   715) !#define DEBUG_AUXVARS
   716) #ifdef DEBUG_AUXVARS
   717)   character(len=MAXWORDLENGTH) :: word
   718)   PetscInt, save :: icall = 0
   719) #endif
   720)   PetscErrorCode :: ierr
   721)   
   722)   option => realization%option
   723)   patch => realization%patch
   724)   grid => patch%grid
   725)   field => realization%field
   726) 
   727)   gen_auxvars => patch%aux%General%auxvars
   728)   gen_auxvars_bc => patch%aux%General%auxvars_bc
   729)   global_auxvars => patch%aux%Global%auxvars
   730)   global_auxvars_bc => patch%aux%Global%auxvars_bc
   731)   material_auxvars => patch%aux%Material%auxvars
   732)     
   733)   call VecGetArrayF90(field%flow_xx_loc,xx_loc_p, ierr);CHKERRQ(ierr)
   734) 
   735) #ifdef DEBUG_AUXVARS
   736)   icall = icall + 1
   737)   write(word,*) icall
   738)   word = 'genaux' // trim(adjustl(word))
   739) #endif
   740)   do ghosted_id = 1, grid%ngmax
   741)     if (grid%nG2L(ghosted_id) < 0) cycle ! bypass ghosted corner cells
   742)      
   743)     !geh - Ignore inactive cells with inactive materials
   744)     if (patch%imat(ghosted_id) <= 0) cycle
   745)     ghosted_end = ghosted_id*option%nflowdof
   746)     ghosted_start = ghosted_end - option%nflowdof + 1
   747)     ! GENERAL_UPDATE_FOR_ACCUM indicates call from non-perturbation
   748)     option%iflag = GENERAL_UPDATE_FOR_ACCUM
   749)     natural_id = grid%nG2A(ghosted_id)
   750)     if (grid%nG2L(ghosted_id) == 0) natural_id = -natural_id
   751)     call GeneralAuxVarCompute(xx_loc_p(ghosted_start:ghosted_end), &
   752)                        gen_auxvars(ZERO_INTEGER,ghosted_id), &
   753)                        global_auxvars(ghosted_id), &
   754)                        material_auxvars(ghosted_id), &
   755)                        patch%characteristic_curves_array( &
   756)                          patch%sat_func_id(ghosted_id))%ptr, &
   757)                        natural_id, &
   758)                        option)
   759)     if (update_state) then
   760)       call GeneralAuxVarUpdateState(xx_loc_p(ghosted_start:ghosted_end), &
   761)                                     gen_auxvars(ZERO_INTEGER,ghosted_id), &
   762)                                     global_auxvars(ghosted_id), &
   763)                                     material_auxvars(ghosted_id), &
   764)                                     patch%characteristic_curves_array( &
   765)                                       patch%sat_func_id(ghosted_id))%ptr, &
   766)                                     natural_id, &  ! for debugging
   767)                                     option)
   768)     endif
   769) #ifdef DEBUG_AUXVARS
   770) !geh: for debugging
   771)     call GeneralOutputAuxVars(gen_auxvars(0,ghosted_id), &
   772)                               global_auxvars(ghosted_id),natural_id,word, &
   773)                               PETSC_TRUE,option)
   774) #endif
   775) #ifdef DEBUG_GENERAL_FILEOUTPUT
   776)   if (debug_flag > 0) then
   777)     write(debug_unit,'(a,i5,i3,7es24.15)') 'auxvar:', natural_id, &
   778)                         global_auxvars(ghosted_id)%istate, &
   779)                         xx_loc_p(ghosted_start:ghosted_end)
   780)   endif
   781) #endif
   782)   enddo
   783) 
   784)   boundary_condition => patch%boundary_condition_list%first
   785)   sum_connection = 0    
   786)   do 
   787)     if (.not.associated(boundary_condition)) exit
   788)     cur_connection_set => boundary_condition%connection_set
   789)     do iconn = 1, cur_connection_set%num_connections
   790)       sum_connection = sum_connection + 1
   791)       local_id = cur_connection_set%id_dn(iconn)
   792)       ghosted_id = grid%nL2G(local_id)
   793)       !geh: negate to indicate boundary connection, not actual cell
   794)       natural_id = -grid%nG2A(ghosted_id) 
   795)       offset = (ghosted_id-1)*option%nflowdof
   796)       if (patch%imat(ghosted_id) <= 0) cycle
   797) 
   798)       xxbc(:) = xx_loc_p(offset+1:offset+option%nflowdof)
   799)       istate = boundary_condition%flow_aux_int_var(GENERAL_STATE_INDEX,iconn)
   800)       if (istate == ANY_STATE) then
   801)         istate = global_auxvars(ghosted_id)%istate
   802)         select case(istate)
   803)           case(LIQUID_STATE,GAS_STATE)
   804)             do idof = 1, option%nflowdof
   805)               select case(boundary_condition%flow_bc_type(idof))
   806)                 case(DIRICHLET_BC,HYDROSTATIC_BC)
   807)                   real_index = boundary_condition%flow_aux_mapping(dof_to_primary_variable(idof,istate))
   808)                   xxbc(idof) = boundary_condition%flow_aux_real_var(real_index,iconn)
   809)               end select   
   810)             enddo
   811)           case(TWO_PHASE_STATE)
   812)             do idof = 1, option%nflowdof
   813)               select case(boundary_condition%flow_bc_type(idof))
   814)                 case(HYDROSTATIC_BC)
   815)                   real_index = boundary_condition%flow_aux_mapping(dof_to_primary_variable(idof,istate))
   816)                   xxbc(idof) = boundary_condition%flow_aux_real_var(real_index,iconn)
   817)                 case(DIRICHLET_BC)
   818)                   variable = dof_to_primary_variable(idof,istate)
   819)                   select case(variable)
   820)                     ! for gas pressure dof
   821)                     case(GENERAL_GAS_PRESSURE_INDEX)
   822)                       real_index = boundary_condition%flow_aux_mapping(variable)
   823)                       if (real_index /= 0) then
   824)                         xxbc(idof) = boundary_condition%flow_aux_real_var(real_index,iconn)
   825)                       else
   826)                         option%io_buffer = 'Mixed FLOW_CONDITION "' // &
   827)                           trim(boundary_condition%flow_condition%name) // &
   828)                           '" needs gas pressure defined.'
   829)                         call printErrMsg(option)
   830)                       endif
   831)                     ! for air pressure dof
   832)                     case(GENERAL_AIR_PRESSURE_INDEX)
   833)                       real_index = boundary_condition%flow_aux_mapping(variable)
   834)                       if (real_index == 0) then ! air pressure not found
   835)                         ! if air pressure is not available, let's try temperature 
   836)                         real_index = boundary_condition%flow_aux_mapping(GENERAL_TEMPERATURE_INDEX)
   837)                         if (real_index /= 0) then
   838)                           temperature = boundary_condition%flow_aux_real_var(real_index,iconn)
   839)                           call EOSWaterSaturationPressure(temperature,saturation_pressure,ierr)
   840)                           ! now verify whether gas pressure is provided through BC
   841)                           if (boundary_condition%flow_bc_type(ONE_INTEGER) == NEUMANN_BC) then
   842)                             gas_pressure = xxbc(ONE_INTEGER)
   843)                           else
   844)                             real_index = boundary_condition%flow_aux_mapping(GENERAL_GAS_PRESSURE_INDEX)
   845)                             if (real_index /= 0) then
   846)                               gas_pressure = boundary_condition%flow_aux_real_var(real_index,iconn)
   847)                             else
   848)                               option%io_buffer = 'Mixed FLOW_CONDITION "' // &
   849)                                 trim(boundary_condition%flow_condition%name) // &
   850)                                 '" needs gas pressure defined to calculate air ' // &
   851)                                 'pressure from temperature.'
   852)                               call printErrMsg(option)
   853)                             endif
   854)                           endif
   855)                           xxbc(idof) = gas_pressure - saturation_pressure
   856)                         else
   857)                           option%io_buffer = 'Cannot find boundary constraint for air pressure.'
   858)                           call printErrMsg(option)
   859)                         endif
   860)                       else
   861)                         xxbc(idof) = boundary_condition%flow_aux_real_var(real_index,iconn)
   862)                       endif
   863)                     ! for gas saturation dof
   864)                     case(GENERAL_GAS_SATURATION_INDEX)
   865)                       real_index = boundary_condition%flow_aux_mapping(variable)
   866)                       if (real_index /= 0) then
   867)                         xxbc(idof) = boundary_condition%flow_aux_real_var(real_index,iconn)
   868)                       else
   869) !geh: should be able to use the saturation within the cell
   870) !                        option%io_buffer = 'Mixed FLOW_CONDITION "' // &
   871) !                          trim(boundary_condition%flow_condition%name) // &
   872) !                          '" needs saturation defined.'
   873) !                        call printErrMsg(option)
   874)                       endif
   875)                     case(GENERAL_TEMPERATURE_INDEX)
   876)                       real_index = boundary_condition%flow_aux_mapping(variable)
   877)                       if (real_index /= 0) then
   878)                         xxbc(idof) = boundary_condition%flow_aux_real_var(real_index,iconn)
   879)                       else
   880)                         option%io_buffer = 'Mixed FLOW_CONDITION "' // &
   881)                           trim(boundary_condition%flow_condition%name) // &
   882)                           '" needs temperature defined.'
   883)                         call printErrMsg(option)
   884)                       endif
   885)                   end select
   886)                 case(NEUMANN_BC)
   887)                 case default
   888)                   option%io_buffer = 'Unknown BC type in GeneralUpdateAuxVars().'
   889)                   call printErrMsg(option)
   890)               end select
   891)             enddo  
   892)         end select
   893)       else
   894)         ! we do this for all BCs; Neumann bcs will be set later
   895)         do idof = 1, option%nflowdof
   896)           real_index = boundary_condition%flow_aux_mapping(dof_to_primary_variable(idof,istate))
   897)           if (real_index > 0) then
   898)             xxbc(idof) = boundary_condition%flow_aux_real_var(real_index,iconn)
   899)           else
   900)             option%io_buffer = 'Error setting up boundary condition in GeneralUpdateAuxVars'
   901)             call printErrMsg(option)
   902)           endif
   903)         enddo
   904)       endif
   905)           
   906)       ! set this based on data given 
   907)       global_auxvars_bc(sum_connection)%istate = istate
   908)       ! GENERAL_UPDATE_FOR_BOUNDARY indicates call from non-perturbation
   909)       option%iflag = GENERAL_UPDATE_FOR_BOUNDARY
   910)       call GeneralAuxVarCompute(xxbc,gen_auxvars_bc(sum_connection), &
   911)                                 global_auxvars_bc(sum_connection), &
   912)                                 material_auxvars(ghosted_id), &
   913)                                 patch%characteristic_curves_array( &
   914)                                   patch%sat_func_id(ghosted_id))%ptr, &
   915)                                 natural_id, &
   916)                                 option)
   917)       ! update state and update aux var; this could result in two update to 
   918)       ! the aux var as update state updates if the state changes
   919)       call GeneralAuxVarUpdateState(xxbc,gen_auxvars_bc(sum_connection), &
   920)                                     global_auxvars_bc(sum_connection), &
   921)                                     material_auxvars(ghosted_id), &
   922)                                     patch%characteristic_curves_array( &
   923)                                       patch%sat_func_id(ghosted_id))%ptr, &
   924)                                     natural_id,option)
   925) #ifdef DEBUG_GENERAL_FILEOUTPUT
   926)       if (debug_flag > 0) then
   927)         write(debug_unit,'(a,i5,i3,7es24.15)') 'bc_auxvar:', natural_id, &
   928)                            global_auxvars_bc(ghosted_id)%istate, &
   929)                             xxbc(:)
   930)       endif
   931) #endif
   932)     enddo
   933)     boundary_condition => boundary_condition%next
   934)   enddo
   935) 
   936)   call VecRestoreArrayF90(field%flow_xx_loc,xx_loc_p, ierr);CHKERRQ(ierr)
   937) 
   938)   patch%aux%General%auxvars_up_to_date = PETSC_TRUE
   939) 
   940) end subroutine GeneralUpdateAuxVars
   941) 
   942) ! ************************************************************************** !
   943) 
   944) subroutine GeneralUpdateFixedAccum(realization)
   945)   ! 
   946)   ! Updates the fixed portion of the
   947)   ! accumulation term
   948)   ! 
   949)   ! Author: Glenn Hammond
   950)   ! Date: 03/10/11
   951)   ! 
   952) 
   953)   use Realization_Subsurface_class
   954)   use Patch_module
   955)   use Option_module
   956)   use Field_module
   957)   use Grid_module
   958)   use Material_Aux_class
   959) 
   960)   implicit none
   961)   
   962)   type(realization_subsurface_type) :: realization
   963)   
   964)   type(option_type), pointer :: option
   965)   type(patch_type), pointer :: patch
   966)   type(grid_type), pointer :: grid
   967)   type(field_type), pointer :: field
   968)   type(general_auxvar_type), pointer :: gen_auxvars(:,:)
   969)   type(global_auxvar_type), pointer :: global_auxvars(:)
   970)   class(material_auxvar_type), pointer :: material_auxvars(:)
   971)   type(material_parameter_type), pointer :: material_parameter
   972) 
   973)   PetscInt :: ghosted_id, local_id, local_start, local_end, natural_id
   974)   PetscInt :: imat
   975)   PetscReal, pointer :: xx_p(:), iphase_loc_p(:)
   976)   PetscReal, pointer :: accum_p(:), accum_p2(:)
   977)   PetscReal :: Jac_dummy(realization%option%nflowdof, &
   978)                          realization%option%nflowdof)
   979)                           
   980)   PetscErrorCode :: ierr
   981)   
   982)   option => realization%option
   983)   field => realization%field
   984)   patch => realization%patch
   985)   grid => patch%grid
   986) 
   987)   gen_auxvars => patch%aux%General%auxvars
   988)   global_auxvars => patch%aux%Global%auxvars
   989)   material_auxvars => patch%aux%Material%auxvars
   990)   material_parameter => patch%aux%Material%material_parameter
   991)     
   992)   call VecGetArrayReadF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
   993) 
   994)   call VecGetArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
   995) 
   996)   !Heeho initialize dynamic accumulation term for every p iteration step
   997)   if (general_tough2_conv_criteria) then
   998)     call VecGetArrayF90(field%flow_accum2, accum_p2, ierr);CHKERRQ(ierr)
   999)   endif
  1000)   
  1001)   do local_id = 1, grid%nlmax
  1002)     ghosted_id = grid%nL2G(local_id)
  1003)     !geh - Ignore inactive cells with inactive materials
  1004)     imat = patch%imat(ghosted_id)
  1005)     if (imat <= 0) cycle
  1006)     natural_id = grid%nG2A(ghosted_id)
  1007)     local_end = local_id*option%nflowdof
  1008)     local_start = local_end - option%nflowdof + 1
  1009)     ! GENERAL_UPDATE_FOR_FIXED_ACCUM indicates call from non-perturbation
  1010)     option%iflag = GENERAL_UPDATE_FOR_FIXED_ACCUM
  1011)     call GeneralAuxVarCompute(xx_p(local_start:local_end), &
  1012)                               gen_auxvars(ZERO_INTEGER,ghosted_id), &
  1013)                               global_auxvars(ghosted_id), &
  1014)                               material_auxvars(ghosted_id), &
  1015)                               patch%characteristic_curves_array( &
  1016)                                 patch%sat_func_id(ghosted_id))%ptr, &
  1017)                               natural_id, &
  1018)                               option)
  1019)     call GeneralAccumulation(gen_auxvars(ZERO_INTEGER,ghosted_id), &
  1020)                              global_auxvars(ghosted_id), &
  1021)                              material_auxvars(ghosted_id), &
  1022)                              material_parameter%soil_heat_capacity(imat), &
  1023)                              option,accum_p(local_start:local_end), &
  1024)                              Jac_dummy,PETSC_FALSE, &
  1025)                              local_id == general_debug_cell_id) 
  1026)   enddo
  1027)   
  1028)   if (general_tough2_conv_criteria) then
  1029)     accum_p2 = accum_p
  1030)   endif
  1031)   
  1032)   call VecRestoreArrayReadF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
  1033) 
  1034)   call VecRestoreArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
  1035)   
  1036)   !Heeho initialize dynamic accumulation term for every p iteration step
  1037)   if (general_tough2_conv_criteria) then
  1038)     call VecRestoreArrayF90(field%flow_accum2, accum_p2, ierr);CHKERRQ(ierr)
  1039)   endif
  1040)   
  1041) end subroutine GeneralUpdateFixedAccum
  1042) 
  1043) ! ************************************************************************** !
  1044) 
  1045) subroutine GeneralAccumulation(gen_auxvar,global_auxvar,material_auxvar, &
  1046)                                soil_heat_capacity,option,Res,Jac, &
  1047)                                analytical_derivatives,debug_cell)
  1048)   ! 
  1049)   ! Computes the non-fixed portion of the accumulation
  1050)   ! term for the residual
  1051)   ! 
  1052)   ! Author: Glenn Hammond
  1053)   ! Date: 03/09/11
  1054)   ! 
  1055) 
  1056)   use Option_module
  1057)   use Material_module
  1058)   use Material_Aux_class
  1059)   
  1060)   implicit none
  1061) 
  1062)   type(general_auxvar_type) :: gen_auxvar
  1063)   type(global_auxvar_type) :: global_auxvar
  1064)   class(material_auxvar_type) :: material_auxvar
  1065)   PetscReal :: soil_heat_capacity
  1066)   type(option_type) :: option
  1067)   PetscReal :: Res(option%nflowdof) 
  1068)   PetscReal :: Jac(option%nflowdof,option%nflowdof)
  1069)   PetscBool :: analytical_derivatives
  1070)   PetscBool :: debug_cell
  1071)   
  1072)   PetscInt :: wat_comp_id, air_comp_id, energy_id
  1073)   PetscInt :: icomp, iphase
  1074)   
  1075)   PetscReal :: porosity
  1076)   PetscReal :: v_over_t
  1077)   
  1078)   wat_comp_id = option%water_id
  1079)   air_comp_id = option%air_id
  1080)   energy_id = option%energy_id
  1081)   
  1082)   ! v_over_t[m^3 bulk/sec] = vol[m^3 bulk] / dt[sec]
  1083)   v_over_t = material_auxvar%volume / option%flow_dt
  1084)   ! must use gen_auxvar%effective porosity here as it enables numerical 
  1085)   ! derivatives to be employed 
  1086)   porosity = gen_auxvar%effective_porosity
  1087)   
  1088)   ! accumulation term units = kmol/s
  1089)   Res = 0.d0
  1090)   do iphase = 1, option%nphase
  1091)     ! Res[kmol comp/m^3 void] = sat[m^3 phase/m^3 void] * 
  1092)     !                           den[kmol phase/m^3 phase] * 
  1093)     !                           xmol[kmol comp/kmol phase]
  1094)     do icomp = 1, option%nflowspec
  1095) #ifdef DEBUG_GENERAL
  1096)       ! for debug version, aux var entries are initialized to NaNs.  even if
  1097)       ! saturation is zero, density may be a NaN.  So the conditional prevents
  1098)       ! this calculation.  For non-debug, aux var entries are initialized to
  1099)       ! 0.d0
  1100)       if (gen_auxvar%sat(iphase) > 0.d0) then
  1101) #endif
  1102)       Res(icomp) = Res(icomp) + gen_auxvar%sat(iphase) * &
  1103)                                 gen_auxvar%den(iphase) * &
  1104)                                 gen_auxvar%xmol(icomp,iphase)
  1105) #ifdef DEBUG_GENERAL
  1106)       endif
  1107) #endif
  1108)     enddo
  1109)   enddo
  1110) 
  1111)   ! scale by porosity * volume / dt
  1112)   ! Res[kmol/sec] = Res[kmol/m^3 void] * por[m^3 void/m^3 bulk] * 
  1113)   !                 vol[m^3 bulk] / dt[sec]
  1114)   Res(1:option%nflowspec) = Res(1:option%nflowspec) * &
  1115)                             porosity * v_over_t
  1116) 
  1117)   do iphase = 1, option%nphase
  1118)     ! Res[MJ/m^3 void] = sat[m^3 phase/m^3 void] *
  1119)     !                    den[kmol phase/m^3 phase] * U[MJ/kmol phase]
  1120) #ifdef DEBUG_GENERAL
  1121)     ! for debug version, aux var entries are initialized to NaNs.  even if
  1122)     ! saturation is zero, density may be a NaN.  So the conditional prevents
  1123)     ! this calculation.  For non-debug, aux var entries are initialized to
  1124)     ! 0.d0
  1125)     if (gen_auxvar%sat(iphase) > 0.d0) then
  1126) #endif
  1127)     Res(energy_id) = Res(energy_id) + gen_auxvar%sat(iphase) * &
  1128)                                       gen_auxvar%den(iphase) * &
  1129)                                       gen_auxvar%U(iphase)
  1130) #ifdef DEBUG_GENERAL
  1131)     endif
  1132) #endif
  1133)   enddo
  1134)   ! Res[MJ/sec] = (Res[MJ/m^3 void] * por[m^3 void/m^3 bulk] + 
  1135)   !                (1-por)[m^3 rock/m^3 bulk] * 
  1136)   !                  dencpr[kg rock/m^3 rock * MJ/kg rock-K] * T[C]) &
  1137)   !               vol[m^3 bulk] / dt[sec]
  1138)   Res(energy_id) = (Res(energy_id) * porosity + &
  1139)                     (1.d0 - porosity) * &
  1140)                     material_auxvar%soil_particle_density * &
  1141)                     soil_heat_capacity * gen_auxvar%temp) * v_over_t
  1142)   
  1143)   if (analytical_derivatives) then
  1144)     Jac = 0.d0
  1145)     select case(global_auxvar%istate)
  1146)       case(LIQUID_STATE)
  1147)         ! satl = 1
  1148)         ! ----------
  1149)         ! Water Equation
  1150)         ! por * satl * denl * Xwl
  1151)         ! ---
  1152)         ! w/respect to liquid pressure
  1153)         ! dpor_dpl * denl * Xwl + 
  1154)         ! por * ddenl_dpl * Xwl
  1155)         Jac(1,1) = &
  1156)           gen_auxvar%d%por_pl * gen_auxvar%den(1) * gen_auxvar%xmol(1,1) + &
  1157)           porosity * gen_auxvar%d%denl_pl * gen_auxvar%xmol(1,1)
  1158)         ! w/respect to air mole fraction
  1159)         ! liquid phase density is indepenent of air mole fraction
  1160)         ! por * denl * dXwl_dXal
  1161)         ! Xwl = 1. - Xal
  1162)         ! dXwl_dXal = -1.
  1163)         Jac(1,2) = porosity * gen_auxvar%den(1) * (-1.d0)
  1164)         ! w/repect to temperature
  1165)         ! por * ddenl_dT * Xwl
  1166)         Jac(1,3) = porosity * gen_auxvar%d%denl_T * gen_auxvar%xmol(1,1)
  1167)         ! ----------
  1168)         ! Air Equation
  1169)         ! por * satl * denl * Xal
  1170)         ! w/respect to liquid pressure
  1171)         ! dpor_dpl * denl * Xal + 
  1172)         ! por * ddenl_dpl * Xal
  1173)         Jac(2,1) = &
  1174)           gen_auxvar%d%por_pl * gen_auxvar%den(1) * gen_auxvar%xmol(2,1) + &
  1175)           porosity * gen_auxvar%d%denl_pl * gen_auxvar%xmol(2,1)
  1176)         ! w/respect to air mole fraction
  1177)         Jac(2,2) = porosity * gen_auxvar%den(1)
  1178)         ! w/repect to temperature
  1179)         ! por * ddenl_dT * Xwl
  1180)         Jac(2,3) = porosity * gen_auxvar%d%denl_T * gen_auxvar%xmol(2,1)
  1181)         ! ----------
  1182)         ! Energy Equation
  1183)         ! por * satl * denl * Ul + (1-por) * dens * Cp * T
  1184)         ! w/respect to liquid pressure
  1185)         ! dpor_dpl * denl * Ul + 
  1186)         ! por * ddenl_dpl * Ul + 
  1187)         ! por * denl * dUl_dpl + 
  1188)         ! -dpor_dpl * dens * Cp * T
  1189)         Jac(3,1) = &
  1190)           gen_auxvar%d%por_pl * gen_auxvar%den(1) * gen_auxvar%U(1) + &
  1191)           porosity * gen_auxvar%d%denl_pl * gen_auxvar%U(1) + &
  1192)           porosity * gen_auxvar%den(1) * gen_auxvar%d%Ul_pl + &
  1193)           (-1.d0) * gen_auxvar%d%por_pl * &
  1194)             material_auxvar%soil_particle_density * &
  1195)             soil_heat_capacity * gen_auxvar%temp
  1196)         ! w/respect to air mole fraction
  1197)         Jac(3,2) = 0.d0
  1198)         ! w/respect to temperature
  1199)         Jac(3,3) = &
  1200)           porosity * gen_auxvar%den(1) * gen_auxvar%d%Ul_T + &
  1201)           (1.d0 - porosity) * material_auxvar%soil_particle_density * &
  1202)             soil_heat_capacity
  1203)       case(GAS_STATE)
  1204)       case(TWO_PHASE_STATE)
  1205) !        if (general_2ph_energy_dof == GENERAL_TEMPERATURE_INDEX) then
  1206)     end select
  1207)     Jac = Jac * v_over_t
  1208)   endif
  1209)   
  1210) #ifdef DEBUG_GENERAL_FILEOUTPUT
  1211)   if (debug_flag > 0) then
  1212)     write(debug_unit,'(a,7es24.15)') 'accum:', Res
  1213)   endif
  1214) #endif                    
  1215) 
  1216) end subroutine GeneralAccumulation
  1217) 
  1218) ! ************************************************************************** !
  1219) 
  1220) subroutine GeneralFlux(gen_auxvar_up,global_auxvar_up, &
  1221)                        material_auxvar_up, &
  1222)                        sir_up, &
  1223)                        thermal_conductivity_up, &
  1224)                        gen_auxvar_dn,global_auxvar_dn, &
  1225)                        material_auxvar_dn, &
  1226)                        sir_dn, &
  1227)                        thermal_conductivity_dn, &
  1228)                        area, dist, general_parameter, &
  1229)                        option,v_darcy,Res,Jup,Jdn, &
  1230)                        analytical_derivatives, &
  1231)                        debug_connection)
  1232)   ! 
  1233)   ! Computes the internal flux terms for the residual
  1234)   ! 
  1235)   ! Author: Glenn Hammond
  1236)   ! Date: 03/09/11
  1237)   ! 
  1238)   use Option_module
  1239)   use Material_Aux_class
  1240)   use Connection_module
  1241)   use Fracture_module
  1242)   use Klinkenberg_module
  1243)   
  1244)   implicit none
  1245)   
  1246)   type(general_auxvar_type) :: gen_auxvar_up, gen_auxvar_dn
  1247)   type(global_auxvar_type) :: global_auxvar_up, global_auxvar_dn
  1248)   class(material_auxvar_type) :: material_auxvar_up, material_auxvar_dn
  1249)   type(option_type) :: option
  1250)   PetscReal :: sir_up(:), sir_dn(:)
  1251)   PetscReal :: v_darcy(option%nphase)
  1252)   PetscReal :: area
  1253)   PetscReal :: dist(-1:3)
  1254)   type(general_parameter_type) :: general_parameter
  1255)   PetscReal :: thermal_conductivity_dn(2)
  1256)   PetscReal :: thermal_conductivity_up(2)
  1257)   PetscReal :: Res(option%nflowdof)
  1258)   PetscReal :: Jup(option%nflowdof,option%nflowdof)
  1259)   PetscReal :: Jdn(option%nflowdof,option%nflowdof)
  1260)   PetscBool :: analytical_derivatives
  1261)   PetscBool :: debug_connection
  1262) 
  1263)   PetscReal :: dist_gravity  ! distance along gravity vector
  1264)   PetscReal :: dist_up, dist_dn
  1265)   PetscReal :: upweight
  1266)   PetscInt :: wat_comp_id, air_comp_id, energy_id
  1267)   PetscInt :: icomp, iphase
  1268)   
  1269)   PetscReal :: xmol(option%nflowspec)
  1270)   PetscReal :: density_ave, density_kg_ave
  1271)   PetscReal :: uH
  1272)   PetscReal :: H_ave
  1273)   PetscReal :: perm_ave_over_dist(option%nphase)
  1274)   PetscReal :: perm_up, perm_dn
  1275)   PetscReal :: delta_pressure, delta_xmol, delta_temp
  1276)   PetscReal :: xmol_air_up, xmol_air_dn
  1277)   PetscReal :: xmass_air_up, xmass_air_dn, delta_xmass
  1278)   PetscReal :: delta_X_whatever
  1279)   PetscReal :: pressure_ave
  1280)   PetscReal :: gravity_term
  1281)   PetscReal :: mobility, mole_flux, q
  1282)   PetscReal :: stpd_up, stpd_dn
  1283)   PetscReal :: sat_up, sat_dn, den_up, den_dn
  1284)   PetscReal :: temp_ave, stpd_ave_over_dist, tempreal
  1285)   PetscReal :: k_eff_up, k_eff_dn, k_eff_ave, heat_flux
  1286)   PetscReal :: adv_flux(3,2), diff_flux(2,2)
  1287)   PetscReal :: debug_flux(3,3), debug_dphi(2)
  1288)   
  1289)   PetscReal :: dummy_dperm_up, dummy_dperm_dn
  1290)   PetscReal :: temp_perm_up, temp_perm_dn
  1291) 
  1292)   PetscReal :: dden_up, dden_dn
  1293)   PetscReal :: dden_dden_kg_up, dden_dden_kg_dn
  1294)   PetscReal :: ddelta_pressure_dpup, ddelta_pressure_dpdn
  1295)   PetscReal :: ddelta_pressure_dTup, ddelta_pressure_dTdn
  1296)   PetscReal :: dmobility_dpup, dmobility_dpdn
  1297)   PetscReal :: dmobility_dsatup, dmobility_dsatdn
  1298)   PetscReal :: dmobility_dTup, dmobility_dTdn
  1299)   PetscReal :: dmole_flux_dpup, dmole_flux_dpdn
  1300)   PetscReal :: dmole_flux_dTup, dmole_flux_dTdn
  1301)   PetscReal :: dv_darcy_dpup, dv_darcy_dpdn
  1302)   PetscReal :: dv_darcy_dTup, dv_darcy_dTdn
  1303)   PetscReal :: duH_dpup, duH_dpdn
  1304)   PetscReal :: duH_dTup, duH_dTdn
  1305)   PetscReal :: dxmol_up, dxmol_dn
  1306)    
  1307)   wat_comp_id = option%water_id
  1308)   air_comp_id = option%air_id
  1309)   energy_id = option%energy_id
  1310) 
  1311)   call ConnectionCalculateDistances(dist,option%gravity,dist_up,dist_dn, &
  1312)                                     dist_gravity,upweight)
  1313)   call material_auxvar_up%PermeabilityTensorToScalar(dist,perm_up)
  1314)   call material_auxvar_dn%PermeabilityTensorToScalar(dist,perm_dn)
  1315)   
  1316)   ! Fracture permeability change only available for structured grid (Heeho)
  1317)   if (associated(material_auxvar_up%fracture)) then
  1318)     call FracturePermEvaluate(material_auxvar_up,perm_up,temp_perm_up, &
  1319)                               dummy_dperm_up,dist)
  1320)     perm_up = temp_perm_up
  1321)   endif
  1322)   if (associated(material_auxvar_dn%fracture)) then
  1323)     call FracturePermEvaluate(material_auxvar_dn,perm_dn,temp_perm_dn, &
  1324)                               dummy_dperm_dn,dist)
  1325)     perm_dn = temp_perm_dn
  1326)   endif
  1327)   
  1328)   if (associated(klinkenberg)) then
  1329)     perm_ave_over_dist(1) = (perm_up * perm_dn) / &
  1330)                             (dist_up*perm_dn + dist_dn*perm_up)
  1331)     temp_perm_up = klinkenberg%Evaluate(perm_up, &
  1332)                                          gen_auxvar_up%pres(option%gas_phase))
  1333)     temp_perm_dn = klinkenberg%Evaluate(perm_dn, &
  1334)                                          gen_auxvar_dn%pres(option%gas_phase))
  1335)     perm_ave_over_dist(2) = (temp_perm_up * temp_perm_dn) / &
  1336)                             (dist_up*temp_perm_dn + dist_dn*temp_perm_up)
  1337)   else
  1338)     perm_ave_over_dist(:) = (perm_up * perm_dn) / &
  1339)                             (dist_up*perm_dn + dist_dn*perm_up)
  1340)   endif
  1341)       
  1342)   Res = 0.d0
  1343)   
  1344)   v_darcy = 0.d0
  1345) #ifdef DEBUG_FLUXES  
  1346)   adv_flux = 0.d0
  1347)   diff_flux = 0.d0
  1348) #endif
  1349) #ifdef DEBUG_GENERAL_FILEOUTPUT
  1350)   debug_flux = 0.d0
  1351)   debug_dphi = 0.d0
  1352) #endif
  1353) 
  1354) #ifdef CONVECTION
  1355)   do iphase = 1, option%nphase
  1356)  
  1357)     if (gen_auxvar_up%mobility(iphase) + &
  1358)         gen_auxvar_dn%mobility(iphase) < eps) then
  1359)       cycle
  1360)     endif
  1361) 
  1362)     density_kg_ave = GeneralAverageDensity(iphase, &
  1363)                                            global_auxvar_up%istate, &
  1364)                                            global_auxvar_dn%istate, &
  1365)                                            gen_auxvar_up%den_kg, &
  1366)                                            gen_auxvar_dn%den_kg, &
  1367)                                            dden_up,dden_dn)
  1368)     gravity_term = density_kg_ave * dist_gravity
  1369)     delta_pressure = gen_auxvar_up%pres(iphase) - &
  1370)                      gen_auxvar_dn%pres(iphase) + &
  1371)                      gravity_term
  1372) 
  1373) #ifdef DEBUG_GENERAL_FILEOUTPUT
  1374)       debug_dphi(iphase) = delta_pressure
  1375) #endif
  1376) 
  1377)     if (delta_pressure >= 0.D0) then
  1378)       mobility = gen_auxvar_up%mobility(iphase)
  1379)       xmol(:) = gen_auxvar_up%xmol(:,iphase)
  1380)       H_ave = gen_auxvar_up%H(iphase)
  1381)       uH = H_ave
  1382)     else
  1383)       mobility = gen_auxvar_dn%mobility(iphase)
  1384)       xmol(:) = gen_auxvar_dn%xmol(:,iphase)
  1385)       H_ave = gen_auxvar_dn%H(iphase)
  1386)       uH = H_ave
  1387)     endif      
  1388) 
  1389)     if (mobility > floweps) then
  1390)       ! v_darcy[m/sec] = perm[m^2] / dist[m] * kr[-] / mu[Pa-sec]
  1391)       !                    dP[Pa]]
  1392)       v_darcy(iphase) = perm_ave_over_dist(iphase) * mobility * delta_pressure
  1393)       density_ave = GeneralAverageDensity(iphase, &
  1394)                                           global_auxvar_up%istate, &
  1395)                                           global_auxvar_dn%istate, &
  1396)                                           gen_auxvar_up%den, &
  1397)                                           gen_auxvar_dn%den, &
  1398)                                           dden_up,dden_dn)
  1399)       ! q[m^3 phase/sec] = v_darcy[m/sec] * area[m^2]
  1400)       q = v_darcy(iphase) * area  
  1401)       ! mole_flux[kmol phase/sec] = q[m^3 phase/sec] * 
  1402)       !                             density_ave[kmol phase/m^3 phase]        
  1403)       mole_flux = q*density_ave
  1404)       ! Res[kmol total/sec]
  1405)       do icomp = 1, option%nflowspec
  1406)         ! Res[kmol comp/sec] = mole_flux[kmol phase/sec] * 
  1407)         !                      xmol[kmol comp/kmol phase]
  1408)         Res(icomp) = Res(icomp) + mole_flux * xmol(icomp)
  1409)       enddo
  1410) #ifdef DEBUG_FLUXES  
  1411)       do icomp = 1, option%nflowspec
  1412)         adv_flux(icomp) = adv_flux(icomp) + mole_flux * xmol(icomp)
  1413)       enddo      ! Res[MJ/sec] = mole_flux[kmol comp/sec] * H_ave[MJ/kmol comp]
  1414) #endif
  1415) #ifdef DEBUG_GENERAL_FILEOUTPUT
  1416)       do icomp = 1, option%nflowspec
  1417)         debug_flux(icomp,iphase) = debug_flux(icomp,iphase) + mole_flux * xmol(icomp)
  1418)       enddo      ! Res[MJ/sec] = mole_flux[kmol comp/sec] * H_ave[MJ/kmol comp]
  1419) #endif
  1420)       Res(energy_id) = Res(energy_id) + mole_flux * uH
  1421) #ifdef DEBUG_FLUXES  
  1422)       adv_flux(energy_id) = adv_flux(energy_id) + mole_flux * uH
  1423) #endif
  1424) #ifdef DEBUG_GENERAL_FILEOUTPUT
  1425)       debug_dphi(iphase) = delta_pressure
  1426)       debug_flux(energy_id,iphase) = debug_flux(energy_id,iphase) + mole_flux * uH
  1427) #endif
  1428)     endif                   
  1429) 
  1430)   enddo
  1431) ! CONVECTION
  1432) #endif
  1433) 
  1434) #ifdef DEBUG_GENERAL_FILEOUTPUT
  1435)   if (debug_flag > 0) then  
  1436)     write(debug_unit,'(a,7es24.15)') 'delta pressure :', debug_dphi(:)
  1437)     write(debug_unit,'(a,7es24.15)') 'adv flux (liquid):', debug_flux(:,1)
  1438)     write(debug_unit,'(a,7es24.15)') 'adv flux (gas):', debug_flux(:,2)
  1439)   endif
  1440)   debug_flux = 0.d0
  1441) #endif                    
  1442) 
  1443) #ifdef DIFFUSION
  1444)   ! add in gas component diffusion in gas and liquid phases
  1445)   do iphase = 1, option%nphase
  1446)     
  1447) #ifndef LIQUID_DIFFUSION  
  1448)     if (iphase == LIQUID_PHASE) cycle
  1449) #endif    
  1450)     
  1451)     sat_up = gen_auxvar_up%sat(iphase)
  1452)     sat_dn = gen_auxvar_dn%sat(iphase)
  1453)     !geh: changed to .and. -> .or.
  1454)     if (sqrt(sat_up*sat_dn) < eps) cycle
  1455)     if (sat_up > eps .or. sat_dn > eps) then
  1456)       ! for now, if liquid state neighboring gas, we allow for minute
  1457)       ! diffusion in liquid phase.
  1458)       if (iphase == option%liquid_phase) then
  1459)         if ((sat_up > eps .or. sat_dn > eps)) then
  1460)           sat_up = max(sat_up,eps)
  1461)           sat_dn = max(sat_dn,eps)
  1462)         endif
  1463)       endif
  1464)       if (general_harmonic_diff_density) then
  1465)         den_up = gen_auxvar_up%den(iphase)
  1466)         den_dn = gen_auxvar_dn%den(iphase)
  1467)       else
  1468)         ! we use upstream weighting when iphase is not equal, otherwise
  1469)         ! arithmetic with 50/50 weighting
  1470)         den_up = GeneralAverageDensity(iphase, &
  1471)                                        global_auxvar_up%istate, &
  1472)                                        global_auxvar_dn%istate, &
  1473)                                        gen_auxvar_up%den, &
  1474)                                        gen_auxvar_dn%den, &
  1475)                                        dden_up,dden_dn)
  1476)         ! by setting both equal, we avoid the harmonic weighting below
  1477)         den_dn = den_up
  1478)       endif
  1479)       stpd_up = sat_up*material_auxvar_up%tortuosity* &
  1480)                 gen_auxvar_up%effective_porosity*den_up
  1481)       stpd_dn = sat_dn*material_auxvar_dn%tortuosity* &
  1482)                 gen_auxvar_dn%effective_porosity*den_dn
  1483)       if (general_diffuse_xmol) then
  1484)         delta_xmol = gen_auxvar_up%xmol(air_comp_id,iphase) - &
  1485)                      gen_auxvar_dn%xmol(air_comp_id,iphase)
  1486)         delta_X_whatever = delta_xmol
  1487)       else
  1488)         xmol_air_up = gen_auxvar_up%xmol(air_comp_id,iphase)
  1489)         xmol_air_dn = gen_auxvar_dn%xmol(air_comp_id,iphase)
  1490)         xmass_air_up = xmol_air_up*fmw_comp(2) / &
  1491)                    (xmol_air_up*fmw_comp(2) + (1.d0-xmol_air_up)*fmw_comp(1))
  1492)         xmass_air_dn = xmol_air_dn*fmw_comp(2) / &
  1493)                    (xmol_air_dn*fmw_comp(2) + (1.d0-xmol_air_dn)*fmw_comp(1))
  1494)         delta_xmass = xmass_air_up - xmass_air_dn
  1495)         delta_X_whatever = delta_xmass
  1496)       endif
  1497)       ! units = [mole/m^4 bulk]
  1498)       stpd_ave_over_dist = (stpd_up*stpd_dn)/(stpd_up*dist_dn+stpd_dn*dist_up)
  1499)       ! need to account for multiple phases
  1500)       tempreal = 1.d0
  1501)       ! Eq. 1.9b.  The gas density is added below
  1502)       if (general_temp_dep_gas_air_diff .and. &
  1503)           iphase == option%gas_phase) then
  1504)         temp_ave = 0.5d0*(gen_auxvar_up%temp+gen_auxvar_dn%temp)
  1505)         pressure_ave = 0.5d0*(gen_auxvar_up%pres(iphase)+ &
  1506)                               gen_auxvar_dn%pres(iphase))
  1507)         tempreal = ((temp_ave+273.15d0)/273.15d0)**1.8d0 * &
  1508)                     101325.d0 / pressure_ave
  1509)       endif
  1510)       ! units = mole/sec
  1511)       mole_flux = stpd_ave_over_dist * tempreal * &
  1512)                   general_parameter%diffusion_coefficient(iphase) * &
  1513)                   delta_X_whatever * area
  1514)       Res(wat_comp_id) = Res(wat_comp_id) - mole_flux
  1515)       Res(air_comp_id) = Res(air_comp_id) + mole_flux
  1516) #ifdef DEBUG_FLUXES  
  1517)       diff_flux(wat_comp_id) = diff_flux(wat_comp_id) - mole_flux
  1518)       diff_flux(air_comp_id) = diff_flux(air_comp_id) + mole_flux      
  1519) #endif
  1520) #ifdef DEBUG_GENERAL_FILEOUTPUT
  1521)       debug_flux(wat_comp_id,iphase) = debug_flux(wat_comp_id,iphase) - mole_flux 
  1522)       debug_flux(air_comp_id,iphase) = debug_flux(air_comp_id,iphase) + mole_flux 
  1523) #endif
  1524)     endif
  1525)   enddo
  1526) ! DIFFUSION
  1527) #endif
  1528) 
  1529) #ifdef CONDUCTION
  1530)   ! add heat conduction flux
  1531)   ! based on Somerton et al., 1974:
  1532)   ! k_eff = k_dry + sqrt(s_l)*(k_sat-k_dry)
  1533)   k_eff_up = thermal_conductivity_up(1) + &
  1534)              sqrt(gen_auxvar_up%sat(option%liquid_phase)) * &
  1535)              (thermal_conductivity_up(2) - thermal_conductivity_up(1))
  1536)   k_eff_dn = thermal_conductivity_dn(1) + &
  1537)              sqrt(gen_auxvar_dn%sat(option%liquid_phase)) * &
  1538)              (thermal_conductivity_dn(2) - thermal_conductivity_dn(1))
  1539)   if (k_eff_up > 0.d0 .or. k_eff_up > 0.d0) then
  1540)     k_eff_ave = (k_eff_up*k_eff_dn)/(k_eff_up*dist_dn+k_eff_dn*dist_up)
  1541)   else
  1542)     k_eff_ave = 0.d0
  1543)   endif
  1544)   ! units:
  1545)   ! k_eff = W/K-m = J/s/K-m
  1546)   ! delta_temp = K
  1547)   ! area = m^2
  1548)   ! heat_flux = k_eff * delta_temp * area = J/s
  1549)   delta_temp = gen_auxvar_up%temp - gen_auxvar_dn%temp
  1550)   heat_flux = k_eff_ave * delta_temp * area * 1.d-6 ! J/s -> MJ/s
  1551)   ! MJ/s
  1552)   Res(energy_id) = Res(energy_id) + heat_flux
  1553) ! CONDUCTION
  1554) #endif
  1555) 
  1556)   if (analytical_derivatives) then
  1557)     Jup = 0.d0
  1558)     Jdn = 0.d0
  1559)     
  1560)     do iphase = 1, option%nphase
  1561)  
  1562)       if (gen_auxvar_up%mobility(iphase) + &
  1563)           gen_auxvar_dn%mobility(iphase) < eps) then
  1564)         cycle
  1565)       endif
  1566) 
  1567)       density_kg_ave = GeneralAverageDensity(iphase, &
  1568)                                              global_auxvar_up%istate, &
  1569)                                              global_auxvar_dn%istate, &
  1570)                                              gen_auxvar_up%den_kg, &
  1571)                                              gen_auxvar_dn%den_kg, &
  1572)                                              dden_dden_kg_up,dden_dden_kg_dn)
  1573)       gravity_term = density_kg_ave * dist_gravity
  1574)       delta_pressure = gen_auxvar_up%pres(iphase) - &
  1575)                        gen_auxvar_dn%pres(iphase) + &
  1576)                        gravity_term
  1577)                        
  1578)       ddelta_pressure_dpup = 1.d0 + dist_gravity * &
  1579)               (dden_dden_kg_up * gen_auxvar_up%d%denl_pl*FMWH2O + &
  1580)                dden_dden_kg_dn * gen_auxvar_dn%d%denl_pl*FMWH2O)
  1581)       ddelta_pressure_dpdn = -1.d0 + dist_gravity * &
  1582)               (dden_dden_kg_up * gen_auxvar_up%d%denl_pl*FMWH2O + &
  1583)                dden_dden_kg_dn * gen_auxvar_dn%d%denl_pl*FMWH2O)
  1584)       ddelta_pressure_dTup = dist_gravity * &
  1585)               (dden_dden_kg_up * gen_auxvar_up%d%denl_T*FMWH2O + &
  1586)                dden_dden_kg_dn * gen_auxvar_dn%d%denl_T*FMWH2O)
  1587)       ddelta_pressure_dTdn = dist_gravity * &
  1588)               (dden_dden_kg_up * gen_auxvar_up%d%denl_T*FMWH2O + &
  1589)                dden_dden_kg_dn * gen_auxvar_dn%d%denl_T*FMWH2O)
  1590) 
  1591)       if (delta_pressure >= 0.D0) then
  1592)         mobility = gen_auxvar_up%mobility(iphase)
  1593)         xmol(:) = gen_auxvar_up%xmol(:,iphase)
  1594)         H_ave = gen_auxvar_up%H(iphase)
  1595)         uH = H_ave
  1596)         
  1597)         duH_dpup = gen_auxvar_up%d%Hl_pl
  1598)         duH_dpdn = 0.d0
  1599)         duH_dTup = gen_auxvar_up%d%Hl_T
  1600)         duH_dTdn = 0.d0
  1601)         dxmol_up = 1.d0
  1602)         dxmol_dn = 0.d0
  1603)         dmobility_dpup = gen_auxvar_up%d%mobilityl_pl
  1604)         dmobility_dsatup = gen_auxvar_up%d%mobilityl_sat
  1605)         dmobility_dTup = gen_auxvar_up%d%mobilityl_T
  1606)         dmobility_dpdn = 0.d0
  1607)         dmobility_dsatdn = 0.d0
  1608)         dmobility_dTdn = 0.d0        
  1609)       else
  1610)         mobility = gen_auxvar_dn%mobility(iphase)
  1611)         xmol(:) = gen_auxvar_dn%xmol(:,iphase)
  1612)         H_ave = gen_auxvar_dn%H(iphase)
  1613)         uH = H_ave
  1614) 
  1615)         duH_dpup = 0.d0
  1616)         duH_dTup = 0.d0
  1617)         duH_dTdn = gen_auxvar_dn%d%Hl_T
  1618)         dxmol_up = 0.d0
  1619)         dxmol_dn = 1.d0
  1620)         dmobility_dpup = 0.d0
  1621)         dmobility_dsatup = 0.d0
  1622)         dmobility_dTup = 0.d0
  1623)         dmobility_dpdn = gen_auxvar_dn%d%mobilityl_pl
  1624)         dmobility_dsatdn = gen_auxvar_dn%d%mobilityl_sat
  1625)         dmobility_dTdn = gen_auxvar_dn%d%mobilityl_T
  1626)       endif      
  1627) 
  1628)       if (mobility > floweps) then
  1629)         ! v_darcy[m/sec] = perm[m^2] / dist[m] * kr[-] / mu[Pa-sec]
  1630)         !                    dP[Pa]]
  1631)         v_darcy(iphase) = perm_ave_over_dist(iphase) * mobility * delta_pressure
  1632)         
  1633)         tempreal = perm_ave_over_dist(iphase)
  1634)         dv_darcy_dpup = tempreal * &
  1635)           (dmobility_dpup * delta_pressure + mobility * ddelta_pressure_dpup)
  1636)         dv_darcy_dTup = tempreal * &
  1637)           (dmobility_dTup * delta_pressure + mobility * ddelta_pressure_dTup)
  1638)         dv_darcy_dpdn = tempreal * &
  1639)           (dmobility_dpdn * delta_pressure + mobility * ddelta_pressure_dpdn)
  1640)         dv_darcy_dTdn = tempreal * &
  1641)           (dmobility_dTdn * delta_pressure + mobility * ddelta_pressure_dTdn)
  1642)         
  1643)         density_ave = GeneralAverageDensity(iphase, &
  1644)                                             global_auxvar_up%istate, &
  1645)                                             global_auxvar_dn%istate, &
  1646)                                             gen_auxvar_up%den, &
  1647)                                             gen_auxvar_dn%den, &
  1648)                                             dden_up,dden_dn)
  1649)         ! q[m^3 phase/sec] = v_darcy[m/sec] * area[m^2]
  1650)         q = v_darcy(iphase) * area  
  1651)         ! mole_flux[kmol phase/sec] = q[m^3 phase/sec] * 
  1652)         !                             density_ave[kmol phase/m^3 phase]        
  1653)         mole_flux = q*density_ave
  1654)         ! Res[kmol total/sec]
  1655) !        do icomp = 1, option%nflowspec
  1656) !          ! Res[kmol comp/sec] = mole_flux[kmol phase/sec] * 
  1657) !          !                      xmol[kmol comp/kmol phase]
  1658) !          Res(icomp) = Res(icomp) + mole_flux * xmol(icomp)
  1659) !        enddo
  1660) !        Res(energy_id) = Res(energy_id) + mole_flux * uH
  1661) 
  1662)         select case(global_auxvar_up%istate)
  1663)           case(LIQUID_STATE)
  1664)             dmole_flux_dpup = &
  1665)               (dv_darcy_dpup * density_ave + &
  1666)                 v_darcy(iphase) * &
  1667)                 (dden_up * gen_auxvar_up%d%denl_pl + &
  1668)                  dden_dn * gen_auxvar_dn%d%denl_pl))
  1669)             dmole_flux_dTup = &
  1670)               (dv_darcy_dTup * density_ave + &
  1671)                 v_darcy(iphase) * &
  1672)                 (dden_up * gen_auxvar_up%d%denl_T + &
  1673)                  dden_dn * gen_auxvar_dn%d%denl_T))
  1674)             do icomp = 1, option%nflowspec
  1675)               Jup(icomp,1) = Jup(icomp,1) + dmole_flux_dpup * xmol(icomp)
  1676)               Jup(icomp,2) = Jup(icomp,2) + mole_flux * dxmol_up
  1677)               Jup(icomp,3) = Jup(icomp,3) + dmole_flux_dTup * xmol(icomp)
  1678)             enddo
  1679)             Jup(energy_id,1) = Jup(energy_id,1) + &
  1680)               (dmole_flux_dpup * uH + mole_flux * duH_dpup)
  1681)             Jup(energy_id,3) = Jup(energy_id,3) + &
  1682)               (dmole_flux_dTup * uH + mole_flux * duH_dTup)
  1683)           case(GAS_STATE)
  1684)           case(TWO_PHASE_STATE)
  1685)         end select
  1686)         select case(global_auxvar_dn%istate)
  1687)           case(LIQUID_STATE)
  1688)             dmole_flux_dpdn = &
  1689)               (dv_darcy_dpdn * density_ave + &
  1690)                 v_darcy(iphase) * &
  1691)                 (dden_up * gen_auxvar_up%d%denl_pl + &
  1692)                  dden_dn * gen_auxvar_dn%d%denl_pl)) 
  1693)             dmole_flux_dTdn = &
  1694)               (dv_darcy_dTdn * density_ave + &
  1695)                 v_darcy(iphase) * &
  1696)                 (dden_up * gen_auxvar_up%d%denl_T + &
  1697)                  dden_dn * gen_auxvar_dn%d%denl_T))
  1698)             do icomp = 1, option%nflowspec
  1699)               Jdn(icomp,1) = Jdn(icomp,1) + dmole_flux_dpdn * xmol(icomp)
  1700)               Jdn(icomp,2) = Jdn(icomp,2) + mole_flux * dxmol_dn
  1701)               Jdn(icomp,3) = Jdn(icomp,3) + dmole_flux_dTdn * xmol(icomp)
  1702)             enddo
  1703)             Jdn(energy_id,1) = Jdn(energy_id,1) + &
  1704)               (dmole_flux_dpdn * uH + mole_flux * duH_dpdn)
  1705)             Jdn(energy_id,3) = Jdn(energy_id,3) + &
  1706)               (dmole_flux_dTdn * uH + mole_flux * duH_dTdn)
  1707)           case(GAS_STATE)
  1708)           case(TWO_PHASE_STATE)
  1709)         end select        
  1710)       endif                   
  1711)     enddo  
  1712)     Jup = Jup * area
  1713)     Jdn = Jdn * area
  1714) 
  1715)     ! add in gas component diffusion in gas and liquid phases
  1716)     do iphase = 1, option%nphase
  1717)     
  1718)       if (iphase == LIQUID_PHASE) cycle
  1719)     
  1720)       sat_up = gen_auxvar_up%sat(iphase)
  1721)       sat_dn = gen_auxvar_dn%sat(iphase)
  1722)       !geh: changed to .and. -> .or.
  1723)       if (sqrt(sat_up*sat_dn) < eps) cycle
  1724)       if (sat_up > eps .or. sat_dn > eps) then
  1725)         ! for now, if liquid state neighboring gas, we allow for minute
  1726)         ! diffusion in liquid phase.
  1727)         if (iphase == option%liquid_phase) then
  1728)           if ((sat_up > eps .or. sat_dn > eps)) then
  1729)             sat_up = max(sat_up,eps)
  1730)             sat_dn = max(sat_dn,eps)
  1731)           endif
  1732)         endif
  1733)         if (general_harmonic_diff_density) then
  1734)           den_up = gen_auxvar_up%den(iphase)
  1735)           den_dn = gen_auxvar_dn%den(iphase)
  1736)         else
  1737)           ! we use upstream weighting when iphase is not equal, otherwise
  1738)           ! arithmetic with 50/50 weighting
  1739)           den_up = GeneralAverageDensity(iphase, &
  1740)                                          global_auxvar_up%istate, &
  1741)                                          global_auxvar_dn%istate, &
  1742)                                          gen_auxvar_up%den, &
  1743)                                          gen_auxvar_dn%den, &
  1744)                                          dden_up,dden_dn)
  1745)           ! by setting both equal, we avoid the harmonic weighting below
  1746)           den_dn = den_up
  1747)         endif
  1748)         stpd_up = sat_up*material_auxvar_up%tortuosity* &
  1749)                   gen_auxvar_up%effective_porosity*den_up
  1750)         stpd_dn = sat_dn*material_auxvar_dn%tortuosity* &
  1751)                   gen_auxvar_dn%effective_porosity*den_dn
  1752)         if (general_diffuse_xmol) then
  1753)           delta_xmol = gen_auxvar_up%xmol(air_comp_id,iphase) - &
  1754)                        gen_auxvar_dn%xmol(air_comp_id,iphase)
  1755)           delta_X_whatever = delta_xmol
  1756)         else
  1757)           xmol_air_up = gen_auxvar_up%xmol(air_comp_id,iphase)
  1758)           xmol_air_dn = gen_auxvar_dn%xmol(air_comp_id,iphase)
  1759)           xmass_air_up = xmol_air_up*fmw_comp(2) / &
  1760)                      (xmol_air_up*fmw_comp(2) + (1.d0-xmol_air_up)*fmw_comp(1))
  1761)           xmass_air_dn = xmol_air_dn*fmw_comp(2) / &
  1762)                      (xmol_air_dn*fmw_comp(2) + (1.d0-xmol_air_dn)*fmw_comp(1))
  1763)           delta_xmass = xmass_air_up - xmass_air_dn
  1764)           delta_X_whatever = delta_xmass
  1765)         endif
  1766)         ! units = [mole/m^4 bulk]
  1767)         stpd_ave_over_dist = (stpd_up*stpd_dn)/(stpd_up*dist_dn+stpd_dn*dist_up)
  1768)         ! need to account for multiple phases
  1769)         tempreal = 1.d0
  1770)         ! Eq. 1.9b.  The gas density is added below
  1771)         if (general_temp_dep_gas_air_diff .and. &
  1772)             iphase == option%gas_phase) then
  1773)           temp_ave = 0.5d0*(gen_auxvar_up%temp+gen_auxvar_dn%temp)
  1774)           pressure_ave = 0.5d0*(gen_auxvar_up%pres(iphase)+ &
  1775)                                 gen_auxvar_dn%pres(iphase))
  1776)           tempreal = ((temp_ave+273.15d0)/273.15d0)**1.8d0 * &
  1777)                       101325.d0 / pressure_ave
  1778)         endif
  1779)         ! units = mole/sec
  1780)         mole_flux = stpd_ave_over_dist * tempreal * &
  1781)                     general_parameter%diffusion_coefficient(iphase) * &
  1782)                     delta_X_whatever * area
  1783)         Res(wat_comp_id) = Res(wat_comp_id) - mole_flux
  1784)         Res(air_comp_id) = Res(air_comp_id) + mole_flux
  1785)       endif
  1786)     enddo
  1787)   ! DIFFUSION
  1788)   endif
  1789)   
  1790) #ifdef DEBUG_FLUXES  
  1791)   if (debug_connection) then  
  1792) !    write(*,'(a,7es12.4)') 'in: ', adv_flux(:)*dist(1), diff_flux(:)*dist(1)
  1793)     write(*,'('' phase: gas'')')
  1794)     write(*,'(''  pressure   :'',2es12.4)') gen_auxvar_up%pres(2), gen_auxvar_dn%pres(2)
  1795)     write(*,'(''  saturation :'',2es12.4)') gen_auxvar_up%sat(2), gen_auxvar_dn%sat(2)
  1796)     write(*,'(''  water --'')')
  1797)     write(*,'(''   darcy flux:'',es12.4)') adv_flux(1,2)
  1798)     write(*,'(''   xmol      :'',2es12.4)') gen_auxvar_up%xmol(1,2), gen_auxvar_dn%xmol(1,2)
  1799)     write(*,'(''   diff flux :'',es12.4)') diff_flux(1,2)
  1800)     write(*,'(''  air --'')')
  1801)     write(*,'(''   darcy flux:'',es12.4)') adv_flux(2,2)
  1802)     write(*,'(''   xmol      :'',2es12.4)') gen_auxvar_up%xmol(2,2), gen_auxvar_dn%xmol(2,2)
  1803)     write(*,'(''   diff flux :'',es12.4)') diff_flux(2,2)
  1804)     write(*,'(''  heat flux  :'',es12.4)') (adv_flux(3,2) + heat_flux)*1.d6
  1805)     write(*,'('' phase: liquid'')')
  1806)     write(*,'(''  pressure   :'',2es12.4)') gen_auxvar_up%pres(1), gen_auxvar_dn%pres(1)
  1807)     write(*,'(''  saturation :'',2es12.4)') gen_auxvar_up%sat(1), gen_auxvar_dn%sat(1)
  1808)     write(*,'(''  water --'')')
  1809)     write(*,'(''   darcy flux:'',es12.4)') adv_flux(1,1)
  1810)     write(*,'(''   xmol      :'',2es12.4)') gen_auxvar_up%xmol(1,1), gen_auxvar_dn%xmol(1,1)
  1811)     write(*,'(''   diff flux :'',es12.4)') diff_flux(1,1)
  1812)     write(*,'(''  air --'')')
  1813)     write(*,'(''   darcy flux:'',es12.4)') adv_flux(2,1)
  1814)     write(*,'(''   xmol      :'',2es12.4)') gen_auxvar_up%xmol(2,1), gen_auxvar_dn%xmol(2,1)
  1815)     write(*,'(''   diff flux :'',es12.4)') diff_flux(2,1)
  1816)     write(*,'(''  heat flux  :'',es12.4)') (adv_flux(3,1) + heat_flux)*1.d6
  1817)   endif
  1818) #endif
  1819) 
  1820) #ifdef DEBUG_GENERAL_FILEOUTPUT
  1821)   debug_flux(energy_id,1) = debug_flux(energy_id,1) + heat_flux
  1822)   if (debug_flag > 0) then  
  1823)     write(debug_unit,'(a,7es24.15)') 'dif flux (liquid):', debug_flux(:,1)
  1824)     write(debug_unit,'(a,7es24.15)') 'dif flux (gas):', debug_flux(:,2)
  1825)   endif
  1826) #endif
  1827) 
  1828) end subroutine GeneralFlux
  1829) 
  1830) ! ************************************************************************** !
  1831) 
  1832) subroutine GeneralBCFlux(ibndtype,auxvar_mapping,auxvars, &
  1833)                          gen_auxvar_up,global_auxvar_up, &
  1834)                          gen_auxvar_dn,global_auxvar_dn, &
  1835)                          material_auxvar_dn, &
  1836)                          sir_dn, &
  1837)                          thermal_conductivity_dn, &
  1838)                          area,dist,general_parameter, &
  1839)                          option,v_darcy,Res,debug_connection)
  1840)   ! 
  1841)   ! Computes the boundary flux terms for the residual
  1842)   ! 
  1843)   ! Author: Glenn Hammond
  1844)   ! Date: 03/09/11
  1845)   ! 
  1846)   use Option_module                              
  1847)   use Material_Aux_class
  1848)   use Fracture_module
  1849)   use Klinkenberg_module
  1850)   
  1851)   implicit none
  1852)   
  1853)   type(general_auxvar_type) :: gen_auxvar_up, gen_auxvar_dn
  1854)   type(global_auxvar_type) :: global_auxvar_up, global_auxvar_dn
  1855)   class(material_auxvar_type) :: material_auxvar_dn
  1856)   type(option_type) :: option
  1857)   PetscReal :: sir_dn(:)
  1858)   PetscReal :: auxvars(:) ! from aux_real_var array
  1859)   PetscReal :: v_darcy(option%nphase), area
  1860)   type(general_parameter_type) :: general_parameter
  1861)   PetscReal :: dist(-1:3)
  1862)   PetscReal :: Res(1:option%nflowdof)
  1863)   PetscInt :: ibndtype(1:option%nflowdof)
  1864)   PetscInt :: auxvar_mapping(GENERAL_MAX_INDEX)
  1865)   PetscReal :: thermal_conductivity_dn(2)
  1866)   PetscBool :: debug_connection
  1867)   
  1868)   PetscInt :: wat_comp_id, air_comp_id, energy_id
  1869)   PetscInt :: icomp, iphase
  1870)   PetscInt :: bc_type
  1871)   PetscReal :: xmol(option%nflowspec)  
  1872)   PetscReal :: density_ave, density_kg_ave
  1873)   PetscReal :: H_ave, uH
  1874)   PetscReal :: perm_dn_adj(option%nphase)
  1875)   PetscReal :: perm_ave_over_dist
  1876)   PetscReal :: dist_gravity
  1877)   PetscReal :: delta_pressure, delta_xmol, delta_temp
  1878)   PetscReal :: gravity_term
  1879)   PetscReal :: mobility, mole_flux, q
  1880)   PetscReal :: sat_dn, perm_dn, den_dn
  1881)   PetscReal :: temp_ave, stpd_ave_over_dist, pres_ave
  1882)   PetscReal :: k_eff_up, k_eff_dn, k_eff_ave, heat_flux
  1883)   PetscReal :: adv_flux(3,2), diff_flux(2,2)
  1884)   PetscReal :: debug_flux(3,3), debug_dphi(2)
  1885)   PetscReal :: boundary_pressure
  1886)   PetscReal :: xmass_air_up, xmass_air_dn, delta_xmass  
  1887)   PetscReal :: xmol_air_up, xmol_air_dn
  1888)   PetscReal :: tempreal
  1889)   PetscReal :: delta_X_whatever
  1890) 
  1891)   PetscReal :: dden_dn, dden_up
  1892) 
  1893)   PetscInt :: idof
  1894)   PetscBool :: neumann_bc_present
  1895)   
  1896)   PetscReal :: temp_perm_dn
  1897)   PetscReal :: dummy_dperm_dn
  1898)   
  1899)   wat_comp_id = option%water_id
  1900)   air_comp_id = option%air_id
  1901)   energy_id = option%energy_id
  1902) 
  1903)   Res = 0.d0
  1904)   v_darcy = 0.d0  
  1905) #ifdef DEBUG_FLUXES    
  1906)   adv_flux = 0.d0
  1907)   diff_flux = 0.d0
  1908) #endif
  1909) #ifdef DEBUG_GENERAL_FILEOUTPUT
  1910)   debug_flux = 0.d0
  1911)   debug_dphi = 0.d0
  1912) #endif
  1913) 
  1914)   neumann_bc_present = PETSC_FALSE
  1915)   
  1916)   call material_auxvar_dn%PermeabilityTensorToScalar(dist,perm_dn)
  1917) 
  1918)   ! Fracture permeability change only available for structured grid (Heeho)
  1919)   if (associated(material_auxvar_dn%fracture)) then
  1920)     call FracturePermEvaluate(material_auxvar_dn,perm_dn,temp_perm_dn, &
  1921)                               dummy_dperm_dn,dist)
  1922)     perm_dn = temp_perm_dn
  1923)   endif  
  1924)   
  1925)   if (associated(klinkenberg)) then
  1926)     perm_dn_adj(1) = perm_dn
  1927)                                           
  1928)     perm_dn_adj(2) = klinkenberg%Evaluate(perm_dn, &
  1929)                                           gen_auxvar_dn%pres(option%gas_phase))
  1930)   else
  1931)     perm_dn_adj(:) = perm_dn
  1932)   endif
  1933)   
  1934) #ifdef CONVECTION  
  1935)   do iphase = 1, option%nphase
  1936)  
  1937)     bc_type = ibndtype(iphase)
  1938)     select case(bc_type)
  1939)       ! figure out the direction of flow
  1940)       case(DIRICHLET_BC,HYDROSTATIC_BC,SEEPAGE_BC,CONDUCTANCE_BC)
  1941) 
  1942)         ! dist(0) = scalar - magnitude of distance
  1943)         ! gravity = vector(3)
  1944)         ! dist(1:3) = vector(3) - unit vector
  1945)         dist_gravity = dist(0) * dot_product(option%gravity,dist(1:3))
  1946)       
  1947)         if (bc_type == CONDUCTANCE_BC) then
  1948)           select case(iphase)
  1949)             case(LIQUID_PHASE)
  1950)               idof = auxvar_mapping(GENERAL_LIQUID_CONDUCTANCE_INDEX)
  1951)             case(GAS_PHASE)
  1952)               idof = auxvar_mapping(GENERAL_GAS_CONDUCTANCE_INDEX)
  1953)           end select        
  1954)           perm_ave_over_dist = auxvars(idof)
  1955)         else
  1956)           perm_ave_over_dist = perm_dn_adj(iphase) / dist(0)
  1957)         endif
  1958)         
  1959)           
  1960)         ! using residual saturation cannot be correct! - geh
  1961)         ! reusing sir_dn for bounary auxvar
  1962) #define BAD_MOVE1 ! this works
  1963) #ifndef BAD_MOVE1       
  1964)         if (gen_auxvar_up%sat(iphase) > sir_dn(iphase) .or. &
  1965)             gen_auxvar_dn%sat(iphase) > sir_dn(iphase)) then
  1966) #endif
  1967)           boundary_pressure = gen_auxvar_up%pres(iphase)
  1968)           if (iphase == LIQUID_PHASE .and. &
  1969)               global_auxvar_up%istate == GAS_STATE) then
  1970)             ! the idea here is to accommodate a free surface boundary
  1971)             ! face.  this will not work for an interior grid cell as
  1972)             ! there should be capillary pressure in force.
  1973)             boundary_pressure = gen_auxvar_up%pres(option%gas_phase)
  1974)           endif
  1975)           density_kg_ave = GeneralAverageDensity(iphase, &
  1976)                                                  global_auxvar_up%istate, &
  1977)                                                  global_auxvar_dn%istate, &
  1978)                                                  gen_auxvar_up%den_kg, &
  1979)                                                  gen_auxvar_dn%den_kg, &
  1980)                                                  dden_up, dden_dn)
  1981)           gravity_term = density_kg_ave * dist_gravity
  1982)           delta_pressure = boundary_pressure - &
  1983)                            gen_auxvar_dn%pres(iphase) + &
  1984)                            gravity_term
  1985) 
  1986) #ifdef DEBUG_GENERAL_FILEOUTPUT
  1987)           debug_dphi(iphase) = delta_pressure
  1988) #endif
  1989) 
  1990)           if (bc_type == SEEPAGE_BC .or. &
  1991)               bc_type == CONDUCTANCE_BC) then
  1992)                 ! flow in         ! boundary cell is <= pref
  1993)             if (delta_pressure > 0.d0 .and. &
  1994)                 gen_auxvar_up%pres(iphase) - &
  1995)                  option%reference_pressure < eps) then
  1996)               delta_pressure = 0.d0
  1997)             endif
  1998)           endif
  1999)             
  2000)           if (delta_pressure >= 0.D0) then
  2001)             mobility = gen_auxvar_up%mobility(iphase)
  2002)             xmol(:) = gen_auxvar_up%xmol(:,iphase)
  2003)             uH = gen_auxvar_up%H(iphase)
  2004)           else
  2005)             mobility = gen_auxvar_dn%mobility(iphase)
  2006)             xmol(:) = gen_auxvar_dn%xmol(:,iphase)
  2007)             uH = gen_auxvar_dn%H(iphase)
  2008)           endif      
  2009) 
  2010)           if (mobility > floweps) then
  2011)             ! v_darcy[m/sec] = perm[m^2] / dist[m] * kr[-] / mu[Pa-sec]
  2012)             !                    dP[Pa]]
  2013)             v_darcy(iphase) = perm_ave_over_dist * mobility * delta_pressure
  2014)             ! only need average density if velocity > 0.
  2015)             density_ave = GeneralAverageDensity(iphase, &
  2016)                                                 global_auxvar_up%istate, &
  2017)                                                 global_auxvar_dn%istate, &
  2018)                                                 gen_auxvar_up%den, &
  2019)                                                 gen_auxvar_dn%den, &
  2020)                                                 dden_up,dden_dn)
  2021)           endif
  2022) #ifndef BAD_MOVE1        
  2023)         endif ! sat > eps
  2024) #endif
  2025) 
  2026)       case(NEUMANN_BC)
  2027)         select case(iphase)
  2028)           case(LIQUID_PHASE)
  2029)             idof = auxvar_mapping(GENERAL_LIQUID_FLUX_INDEX)
  2030)           case(GAS_PHASE)
  2031)             idof = auxvar_mapping(GENERAL_GAS_FLUX_INDEX)
  2032)         end select
  2033)         
  2034)         neumann_bc_present = PETSC_TRUE
  2035)         xmol = 0.d0
  2036)         xmol(iphase) = 1.d0
  2037)         if (dabs(auxvars(idof)) > floweps) then
  2038)           v_darcy(iphase) = auxvars(idof)
  2039)           if (v_darcy(iphase) > 0.d0) then 
  2040)             density_ave = gen_auxvar_up%den(iphase)
  2041)             uH = gen_auxvar_up%H(iphase)
  2042)           else 
  2043)             density_ave = gen_auxvar_dn%den(iphase)
  2044)             uH = gen_auxvar_dn%H(iphase)
  2045)           endif 
  2046)         endif
  2047)       case default
  2048)         option%io_buffer = &
  2049)           'Boundary condition type not recognized in GeneralBCFlux phase loop.'
  2050)         call printErrMsg(option)
  2051)     end select
  2052) 
  2053)     if (dabs(v_darcy(iphase)) > 0.d0) then
  2054)       ! q[m^3 phase/sec] = v_darcy[m/sec] * area[m^2]
  2055)       q = v_darcy(iphase) * area
  2056)       ! mole_flux[kmol phase/sec] = q[m^3 phase/sec] * 
  2057)       !                              density_ave[kmol phase/m^3 phase]
  2058)       mole_flux = q*density_ave       
  2059)       ! Res[kmol total/sec]
  2060)       do icomp = 1, option%nflowspec
  2061)         ! Res[kmol comp/sec] = mole_flux[kmol phase/sec] * 
  2062)         !                      xmol[kmol comp/mol phase]
  2063)         Res(icomp) = Res(icomp) + mole_flux * xmol(icomp)
  2064)       enddo
  2065) #ifdef DEBUG_FLUXES  
  2066)       do icomp = 1, option%nflowspec
  2067)         adv_flux(icomp,iphase) = adv_flux(icomp,iphase) + mole_flux * xmol(icomp)
  2068)       enddo
  2069) #endif
  2070) #ifdef DEBUG_GENERAL_FILEOUTPUT
  2071)       do icomp = 1, option%nflowspec
  2072)         debug_flux(icomp,iphase) = debug_flux(icomp,iphase) + mole_flux * xmol(icomp)
  2073)       enddo
  2074) #endif
  2075)       ! Res[MJ/sec] = mole_flux[kmol comp/sec] * H_ave[MJ/kmol comp]
  2076)       Res(energy_id) = Res(energy_id) + mole_flux * uH ! H_ave
  2077) #ifdef DEBUG_FLUXES  
  2078)       adv_flux(energy_id,iphase) = adv_flux(energy_id,iphase) + mole_flux * uH
  2079) #endif
  2080) #ifdef DEBUG_GENERAL_FILEOUTPUT
  2081)       debug_flux(energy_id,iphase) = debug_flux(energy_id,iphase) + mole_flux * uH
  2082) #endif
  2083)     endif
  2084)   enddo
  2085) ! CONVECTION
  2086) #endif
  2087)   
  2088) #ifdef DEBUG_GENERAL_FILEOUTPUT
  2089)   if (debug_flag > 0) then 
  2090)     write(debug_unit,'(a,7es24.15)') 'bc delta pressure :', debug_dphi(:)  
  2091)     write(debug_unit,'(a,7es24.15)') 'bc adv flux (liquid):', debug_flux(:,1)
  2092)     write(debug_unit,'(a,7es24.15)') 'bc adv flux (gas):', debug_flux(:,2)
  2093)   endif
  2094)   debug_flux = 0.d0
  2095) #endif  
  2096) 
  2097) #ifdef DIFFUSION
  2098)   ! add in gas component diffusion in gas and liquid phases
  2099)   do iphase = 1, option%nphase
  2100)   
  2101) #ifdef LIQUID_DIFFUSION    
  2102) !    if (neumann_bc_present) cycle
  2103)     if (ibndtype(iphase) == NEUMANN_BC) cycle
  2104) #else
  2105)     if (iphase == LIQUID_PHASE) cycle
  2106) #endif
  2107)     
  2108)     ! diffusion all depends upon the downwind cell.  phase diffusion only
  2109)     ! occurs if a phase exists in both auxvars (boundary and internal) or
  2110)     ! a liquid phase exists in the internal cell. so, one could say that
  2111)     ! liquid diffusion always exists as the internal cell has a liquid phase,
  2112)     ! but gas phase diffusion only occurs if the internal cell has a gas
  2113)     ! phase.
  2114)     if (gen_auxvar_dn%sat(iphase) > eps) then
  2115)       sat_dn = gen_auxvar_dn%sat(iphase)
  2116)       if (general_harmonic_diff_density) then
  2117)         den_dn = gen_auxvar_dn%den(iphase)
  2118)       else
  2119)         ! we use upstream weighting when iphase is not equal, otherwise
  2120)         ! arithmetic with 50/50 weighting
  2121)         den_dn = GeneralAverageDensity(iphase, &
  2122)                                        global_auxvar_up%istate, &
  2123)                                        global_auxvar_dn%istate, &
  2124)                                        gen_auxvar_up%den, &
  2125)                                        gen_auxvar_dn%den, &
  2126)                                        dden_up,dden_dn)
  2127)       endif
  2128)       ! units = [mole/m^4 bulk]
  2129)       stpd_ave_over_dist = sat_dn*material_auxvar_dn%tortuosity * &
  2130)                            gen_auxvar_dn%effective_porosity * &
  2131)                            den_dn / dist(0)
  2132)       if (general_diffuse_xmol) then
  2133)         delta_xmol = gen_auxvar_up%xmol(air_comp_id,iphase) - &
  2134)                      gen_auxvar_dn%xmol(air_comp_id,iphase)
  2135)         delta_X_whatever = delta_xmol
  2136)       else
  2137)         xmol_air_up = gen_auxvar_up%xmol(air_comp_id,iphase)
  2138)         xmol_air_dn = gen_auxvar_dn%xmol(air_comp_id,iphase)
  2139)         xmass_air_up = xmol_air_up*fmw_comp(2) / &
  2140)                    (xmol_air_up*fmw_comp(2) + (1.d0-xmol_air_up)*fmw_comp(1))
  2141)         xmass_air_dn = xmol_air_dn*fmw_comp(2) / &
  2142)                    (xmol_air_dn*fmw_comp(2) + (1.d0-xmol_air_dn)*fmw_comp(1))
  2143)         delta_xmass = xmass_air_up - xmass_air_dn
  2144)         delta_X_whatever = delta_xmass
  2145)       endif
  2146)       ! need to account for multiple phases
  2147)       ! units = (m^3 water/m^4 bulk)*(m^2 bulk/sec) = m^3 water/m^2 bulk/sec
  2148)       tempreal = 1.d0
  2149)       ! Eq. 1.9b.  The gas density is added below
  2150)       if (general_temp_dep_gas_air_diff .and. &
  2151)           iphase == option%gas_phase) then
  2152)         temp_ave = 0.5d0*(gen_auxvar_up%temp+gen_auxvar_dn%temp)
  2153)         pres_ave = 0.5d0*(gen_auxvar_up%pres(iphase)+ &
  2154)                           gen_auxvar_dn%pres(iphase))
  2155)         tempreal = ((temp_ave+273.15d0)/273.15d0)**1.8d0 * &
  2156)                     101325.d0 / pres_ave
  2157)       endif
  2158)       ! units = mole/sec
  2159)       mole_flux = stpd_ave_over_dist * tempreal * &
  2160)                   general_parameter%diffusion_coefficient(iphase) * &
  2161)                   delta_X_whatever * area
  2162)       Res(wat_comp_id) = Res(wat_comp_id) - mole_flux
  2163)       Res(air_comp_id) = Res(air_comp_id) + mole_flux
  2164) #ifdef DEBUG_FLUXES  
  2165)       ! equal but opposite
  2166)       diff_flux(wat_comp_id,iphase) = diff_flux(wat_comp_id,iphase) - mole_flux
  2167)       diff_flux(air_comp_id,iphase) = diff_flux(air_comp_id,iphase) + mole_flux
  2168) #endif
  2169) #ifdef DEBUG_GENERAL_FILEOUTPUT
  2170)       debug_flux(wat_comp_id,iphase) = debug_flux(wat_comp_id,iphase) - mole_flux
  2171)       debug_flux(air_comp_id,iphase) = debug_flux(air_comp_id,iphase) + mole_flux
  2172) #endif
  2173)     endif
  2174)   enddo
  2175) ! DIFFUSION
  2176) #endif
  2177) 
  2178) #ifdef CONDUCTION
  2179)   ! add heat conduction flux
  2180)   heat_flux = 0.d0
  2181)   select case (ibndtype(GENERAL_ENERGY_EQUATION_INDEX))
  2182)     case (DIRICHLET_BC)
  2183)       ! based on Somerton et al., 1974:
  2184)       ! k_eff = k_dry + sqrt(s_l)*(k_sat-k_dry)
  2185)       k_eff_dn = thermal_conductivity_dn(1) + &
  2186)                  sqrt(gen_auxvar_dn%sat(option%liquid_phase)) * &
  2187)                  (thermal_conductivity_dn(2) - thermal_conductivity_dn(1))
  2188)       ! units:
  2189)       ! k_eff = W/K/m/m = J/s/K/m/m
  2190)       ! delta_temp = K
  2191)       ! area = m^2
  2192)       ! heat_flux = J/s
  2193)       k_eff_ave = k_eff_dn / dist(0)
  2194)       delta_temp = gen_auxvar_up%temp - gen_auxvar_dn%temp
  2195)       heat_flux = k_eff_ave * delta_temp * area * 1.d-6 ! convert W -> MW
  2196)     case(NEUMANN_BC)
  2197)                   ! flux prescribed as MW/m^2
  2198)       heat_flux = auxvars(auxvar_mapping(GENERAL_ENERGY_FLUX_INDEX)) * area
  2199) 
  2200)     case default
  2201)       option%io_buffer = 'Boundary condition type not recognized in ' // &
  2202)         'GeneralBCFlux heat conduction loop.'
  2203)       call printErrMsg(option)
  2204)   end select
  2205)   Res(energy_id) = Res(energy_id) + heat_flux ! MW
  2206) ! CONDUCTION
  2207) #endif
  2208) 
  2209) #ifdef DEBUG_FLUXES  
  2210)   if (debug_connection) then  
  2211) !    write(*,'(a,7es12.4)') 'in: ', adv_flux(:)*dist(1), diff_flux(:)*dist(1)
  2212)     write(*,'('' phase: gas'')')
  2213)     write(*,'(''  pressure   :'',2es12.4)') gen_auxvar_up%pres(2), gen_auxvar_dn%pres(2)
  2214)     write(*,'(''  saturation :'',2es12.4)') gen_auxvar_up%sat(2), gen_auxvar_dn%sat(2)
  2215)     write(*,'(''  water --'')')
  2216)     write(*,'(''   darcy flux:'',es12.4)') adv_flux(1,2)
  2217)     write(*,'(''   xmol      :'',2es12.4)') gen_auxvar_up%xmol(1,2), gen_auxvar_dn%xmol(1,2)
  2218)     write(*,'(''   diff flux :'',es12.4)') diff_flux(1,2)
  2219)     write(*,'(''  air --'')')
  2220)     write(*,'(''   darcy flux:'',es12.4)') adv_flux(2,2)
  2221)     write(*,'(''   xmol      :'',2es12.4)') gen_auxvar_up%xmol(2,2), gen_auxvar_dn%xmol(2,2)
  2222)     write(*,'(''   diff flux :'',es12.4)') diff_flux(2,2)
  2223)     write(*,'(''  heat flux  :'',es12.4)') (adv_flux(3,2) + heat_flux)*1.d6
  2224)     write(*,'('' phase: liquid'')')
  2225)     write(*,'(''  pressure   :'',2es12.4)') gen_auxvar_up%pres(1), gen_auxvar_dn%pres(1)
  2226)     write(*,'(''  saturation :'',2es12.4)') gen_auxvar_up%sat(1), gen_auxvar_dn%sat(1)
  2227)     write(*,'(''  water --'')')
  2228)     write(*,'(''   darcy flux:'',es12.4)') adv_flux(1,1)
  2229)     write(*,'(''   xmol      :'',2es12.4)') gen_auxvar_up%xmol(1,1), gen_auxvar_dn%xmol(1,1)
  2230)     write(*,'(''   diff flux :'',es12.4)') diff_flux(1,1)
  2231)     write(*,'(''  air --'')')
  2232)     write(*,'(''   darcy flux:'',es12.4)') adv_flux(2,1)
  2233)     write(*,'(''   xmol      :'',2es12.4)') gen_auxvar_up%xmol(2,1), gen_auxvar_dn%xmol(2,1)
  2234)     write(*,'(''   diff flux :'',es12.4)') diff_flux(2,1)
  2235)     write(*,'(''  heat flux  :'',es12.4)') (adv_flux(3,1) + heat_flux)*1.d6
  2236)   endif
  2237) #endif
  2238) 
  2239) #ifdef DEBUG_GENERAL_FILEOUTPUT
  2240)   debug_flux(energy_id,1) = debug_flux(energy_id,1) + heat_flux
  2241)   if (debug_flag > 0) then  
  2242)     write(debug_unit,'(a,7es24.15)') 'bc dif flux (liquid):', debug_flux(:,1)*dist(3)
  2243)     write(debug_unit,'(a,7es24.15)') 'bc dif flux (gas):', debug_flux(:,2)*dist(3)
  2244)   endif
  2245) #endif
  2246)   
  2247) end subroutine GeneralBCFlux
  2248) 
  2249) ! ************************************************************************** !
  2250) 
  2251) subroutine GeneralSrcSink(option,qsrc,flow_src_sink_type, &
  2252)                           gen_auxvar,global_auxvar,ss_flow_vol_flux, &
  2253)                           scale,Res,debug_cell)
  2254)   ! 
  2255)   ! Computes the source/sink terms for the residual
  2256)   ! 
  2257)   ! Author: Glenn Hammond
  2258)   ! Date: 03/09/11
  2259)   ! 
  2260) 
  2261)   use Option_module
  2262)   
  2263)   use EOS_Water_module
  2264)   use EOS_Gas_module
  2265) 
  2266)   implicit none
  2267) 
  2268)   type(option_type) :: option
  2269)   PetscReal :: qsrc(:)
  2270)   PetscInt :: flow_src_sink_type
  2271)   type(general_auxvar_type) :: gen_auxvar
  2272)   type(global_auxvar_type) :: global_auxvar
  2273)   PetscReal :: ss_flow_vol_flux(option%nphase)
  2274)   PetscReal :: scale
  2275)   PetscReal :: Res(option%nflowdof)
  2276)   PetscBool :: debug_cell
  2277)       
  2278)   PetscReal :: qsrc_mol
  2279)   PetscReal :: enthalpy, internal_energy
  2280)   PetscReal :: cell_pressure, dummy_pressure
  2281)   PetscInt :: icomp
  2282)   PetscErrorCode :: ierr
  2283) 
  2284)   Res = 0.d0
  2285)   do icomp = 1, option%nflowspec
  2286)     qsrc_mol = 0.d0
  2287)     select case(flow_src_sink_type)
  2288)       case(MASS_RATE_SS)
  2289)         qsrc_mol = qsrc(icomp)/fmw_comp(icomp) ! kg/sec -> kmol/sec
  2290)       case(SCALED_MASS_RATE_SS)                       ! kg/sec -> kmol/sec
  2291)         qsrc_mol = qsrc(icomp)/fmw_comp(icomp)*scale 
  2292)       case(VOLUMETRIC_RATE_SS)  ! assume local density for now
  2293)         ! qsrc1 = m^3/sec
  2294)         qsrc_mol = qsrc(icomp)*gen_auxvar%den(icomp) ! den = kmol/m^3
  2295)       case(SCALED_VOLUMETRIC_RATE_SS)  ! assume local density for now
  2296)         ! qsrc1 = m^3/sec             ! den = kmol/m^3
  2297)         qsrc_mol = qsrc(icomp)*gen_auxvar%den(icomp)*scale 
  2298)     end select
  2299)     ! icomp here is really iphase
  2300)     ss_flow_vol_flux(icomp) = qsrc_mol/gen_auxvar%den(icomp)
  2301)     Res(icomp) = qsrc_mol
  2302)   enddo
  2303)   if (dabs(qsrc(TWO_INTEGER)) < 1.d-40 .and. &
  2304)       qsrc(ONE_INTEGER) < 0.d0) then ! extraction only
  2305)     ! Res(1) holds qsrc_mol for water.  If the src/sink value for air is zero,
  2306)     ! remove/add the equivalent mole fraction of air in the liquid phase.
  2307)     qsrc_mol = Res(ONE_INTEGER)*gen_auxvar%xmol(TWO_INTEGER,ONE_INTEGER)
  2308)     Res(TWO_INTEGER) = qsrc_mol
  2309)     ss_flow_vol_flux(TWO_INTEGER) = qsrc_mol/gen_auxvar%den(TWO_INTEGER)
  2310)   endif
  2311)   ! energy units: MJ/sec
  2312)   if (size(qsrc) == THREE_INTEGER) then
  2313)     if (dabs(qsrc(THREE_INTEGER)) < 1.d-40) then
  2314)       cell_pressure = &
  2315)         maxval(gen_auxvar%pres(option%liquid_phase:option%gas_phase))
  2316)       if (dabs(qsrc(ONE_INTEGER)) > 0.d0) then
  2317)         call EOSWaterEnthalpy(gen_auxvar%temp,cell_pressure,enthalpy,ierr)
  2318)         enthalpy = enthalpy * 1.d-6 ! J/kmol -> whatever units
  2319)         ! enthalpy units: MJ/kmol                       ! water component mass
  2320)         Res(option%energy_id) = Res(option%energy_id) + Res(ONE_INTEGER) * &
  2321)                                                         enthalpy
  2322)       endif
  2323)       if (dabs(qsrc(TWO_INTEGER)) > 0.d0) then
  2324)         ! this is pure air, we use the enthalpy of air, NOT the air/water
  2325)         ! mixture in gas
  2326)         ! air enthalpy is only a function of temperature and the 
  2327)         dummy_pressure = 0.d0
  2328)         call EOSGasEnergy(gen_auxvar%temp,dummy_pressure, &
  2329)                           enthalpy,internal_energy,ierr)
  2330)         enthalpy = enthalpy * 1.d-6 ! J/kmol -> MJ/kmol                                  
  2331)         ! enthalpy units: MJ/kmol                       ! air component mass
  2332)         Res(option%energy_id) = Res(option%energy_id) + Res(TWO_INTEGER) * &
  2333)                                                         enthalpy
  2334)       endif
  2335)     else
  2336)       Res(option%energy_id) = qsrc(THREE_INTEGER)*scale ! MJ/s
  2337)     endif
  2338)   endif
  2339)   
  2340) #ifdef DEBUG_GENERAL_FILEOUTPUT
  2341)   if (debug_flag > 0) then  
  2342)     write(debug_unit,'(a,7es24.15)') 'src/sink:', Res(1)-Res(2),Res(12:3)
  2343)   endif
  2344) #endif   
  2345)   
  2346) end subroutine GeneralSrcSink
  2347) 
  2348) ! ************************************************************************** !
  2349) 
  2350) subroutine GeneralAccumDerivative(gen_auxvar,global_auxvar,material_auxvar, &
  2351)                                   soil_heat_capacity,option,J)
  2352)   ! 
  2353)   ! Computes derivatives of the accumulation
  2354)   ! term for the Jacobian
  2355)   ! 
  2356)   ! Author: Glenn Hammond
  2357)   ! Date: 03/09/11
  2358)   ! 
  2359) 
  2360)   use Option_module
  2361)   use Saturation_Function_module
  2362)   use Material_Aux_class
  2363)   
  2364)   implicit none
  2365) 
  2366)   type(general_auxvar_type) :: gen_auxvar(0:)
  2367)   type(global_auxvar_type) :: global_auxvar
  2368)   class(material_auxvar_type) :: material_auxvar
  2369)   type(option_type) :: option
  2370)   PetscReal :: soil_heat_capacity
  2371)   PetscReal :: J(option%nflowdof,option%nflowdof)
  2372)      
  2373)   PetscReal :: res(option%nflowdof), res_pert(option%nflowdof)
  2374)   PetscReal :: jac(option%nflowdof,option%nflowdof)
  2375)   PetscReal :: jac_pert(option%nflowdof,option%nflowdof)
  2376)   PetscInt :: idof, irow
  2377) 
  2378) !geh:print *, 'GeneralAccumDerivative'
  2379) 
  2380)   call GeneralAccumulation(gen_auxvar(ZERO_INTEGER), &
  2381)                            global_auxvar, &
  2382)                            material_auxvar,soil_heat_capacity,option, &
  2383)                            res,jac,general_analytical_derivatives, &
  2384)                            PETSC_FALSE)
  2385)                            
  2386)   do idof = 1, option%nflowdof
  2387)     call GeneralAccumulation(gen_auxvar(idof), &
  2388)                              global_auxvar, &
  2389)                              material_auxvar,soil_heat_capacity, &
  2390)                              option,res_pert,jac_pert,PETSC_FALSE,PETSC_FALSE)
  2391)     do irow = 1, option%nflowdof
  2392)       J(irow,idof) = (res_pert(irow)-res(irow))/gen_auxvar(idof)%pert
  2393) !geh:print *, irow, idof, J(irow,idof), gen_auxvar(idof)%pert
  2394)     enddo !irow
  2395)   enddo ! idof
  2396) 
  2397)   if (general_analytical_derivatives) then
  2398)     J = jac
  2399)   endif
  2400) 
  2401)   if (general_isothermal) then
  2402)     J(GENERAL_ENERGY_EQUATION_INDEX,:) = 0.d0
  2403)     J(:,GENERAL_ENERGY_EQUATION_INDEX) = 0.d0
  2404)   endif
  2405)   
  2406)   if (general_no_air) then
  2407)     J(GENERAL_GAS_EQUATION_INDEX,:) = 0.d0
  2408)     J(:,GENERAL_GAS_EQUATION_INDEX) = 0.d0
  2409)   endif
  2410)   
  2411) #ifdef DEBUG_GENERAL_FILEOUTPUT
  2412)   if (debug_flag > 0) then
  2413)     write(debug_unit,'(a,10es24.15)') 'accum deriv:', J
  2414)   endif
  2415) #endif
  2416) 
  2417) end subroutine GeneralAccumDerivative
  2418) 
  2419) ! ************************************************************************** !
  2420) 
  2421) subroutine GeneralFluxDerivative(gen_auxvar_up,global_auxvar_up, &
  2422)                                  material_auxvar_up, &
  2423)                                  sir_up, &
  2424)                                  thermal_conductivity_up, &
  2425)                                  gen_auxvar_dn,global_auxvar_dn, &
  2426)                                  material_auxvar_dn, &
  2427)                                  sir_dn, &
  2428)                                  thermal_conductivity_dn, &
  2429)                                  area, dist, &
  2430)                                  general_parameter, &
  2431)                                  option,Jup,Jdn)
  2432)   ! 
  2433)   ! Computes the derivatives of the internal flux terms
  2434)   ! for the Jacobian
  2435)   ! 
  2436)   ! Author: Glenn Hammond
  2437)   ! Date: 03/09/11
  2438)   ! 
  2439)   use Option_module
  2440)   use Material_Aux_class
  2441)   
  2442)   implicit none
  2443)   
  2444)   type(general_auxvar_type) :: gen_auxvar_up(0:), gen_auxvar_dn(0:)
  2445)   type(global_auxvar_type) :: global_auxvar_up, global_auxvar_dn
  2446)   class(material_auxvar_type) :: material_auxvar_up, material_auxvar_dn
  2447)   type(option_type) :: option
  2448)   PetscReal :: sir_up(:), sir_dn(:)
  2449)   PetscReal :: thermal_conductivity_dn(2)
  2450)   PetscReal :: thermal_conductivity_up(2)
  2451)   PetscReal :: area
  2452)   PetscReal :: dist(-1:3)
  2453)   type(general_parameter_type) :: general_parameter
  2454)   PetscReal :: Jup(option%nflowdof,option%nflowdof)
  2455)   PetscReal :: Jdn(option%nflowdof,option%nflowdof)
  2456)   PetscReal :: Janal_up(option%nflowdof,option%nflowdof)
  2457)   PetscReal :: Janal_dn(option%nflowdof,option%nflowdof)
  2458)   PetscReal :: Jdummy(option%nflowdof,option%nflowdof)
  2459) 
  2460)   PetscReal :: v_darcy(option%nphase)
  2461)   PetscReal :: res(option%nflowdof), res_pert(option%nflowdof)
  2462)   PetscInt :: idof, irow
  2463) 
  2464)   Jup = 0.d0
  2465)   Jdn = 0.d0
  2466)   
  2467) !geh:print *, 'GeneralFluxDerivative'
  2468)   option%iflag = -2
  2469)   call GeneralFlux(gen_auxvar_up(ZERO_INTEGER),global_auxvar_up, &
  2470)                    material_auxvar_up,sir_up, &
  2471)                    thermal_conductivity_up, &
  2472)                    gen_auxvar_dn(ZERO_INTEGER),global_auxvar_dn, &
  2473)                    material_auxvar_dn,sir_dn, &
  2474)                    thermal_conductivity_dn, &
  2475)                    area,dist,general_parameter, &
  2476)                    option,v_darcy,res,Janal_up,Janal_dn,&
  2477)                    general_analytical_derivatives,PETSC_FALSE)
  2478)                            
  2479)   ! upgradient derivatives
  2480)   do idof = 1, option%nflowdof
  2481)     call GeneralFlux(gen_auxvar_up(idof),global_auxvar_up, &
  2482)                      material_auxvar_up,sir_up, &
  2483)                      thermal_conductivity_up, &
  2484)                      gen_auxvar_dn(ZERO_INTEGER),global_auxvar_dn, &
  2485)                      material_auxvar_dn,sir_dn, &
  2486)                      thermal_conductivity_dn, &
  2487)                      area,dist,general_parameter, &
  2488)                      option,v_darcy,res_pert,Jdummy,Jdummy, &
  2489)                      PETSC_FALSE,PETSC_FALSE)
  2490)     do irow = 1, option%nflowdof
  2491)       Jup(irow,idof) = (res_pert(irow)-res(irow))/gen_auxvar_up(idof)%pert
  2492) !geh:print *, 'up: ', irow, idof, Jup(irow,idof), gen_auxvar_up(idof)%pert
  2493)     enddo !irow
  2494)   enddo ! idof
  2495) 
  2496)   ! downgradient derivatives
  2497)   do idof = 1, option%nflowdof
  2498)     call GeneralFlux(gen_auxvar_up(ZERO_INTEGER),global_auxvar_up, &
  2499)                      material_auxvar_up,sir_up, &
  2500)                      thermal_conductivity_up, &
  2501)                      gen_auxvar_dn(idof),global_auxvar_dn, &
  2502)                      material_auxvar_dn,sir_dn, &
  2503)                      thermal_conductivity_dn, &
  2504)                      area,dist,general_parameter, &
  2505)                      option,v_darcy,res_pert,Jdummy,Jdummy, &
  2506)                      PETSC_FALSE,PETSC_FALSE)
  2507)     do irow = 1, option%nflowdof
  2508)       Jdn(irow,idof) = (res_pert(irow)-res(irow))/gen_auxvar_dn(idof)%pert
  2509) !geh:print *, 'dn: ', irow, idof, Jdn(irow,idof), gen_auxvar_dn(idof)%pert
  2510)     enddo !irow
  2511)   enddo ! idof
  2512) 
  2513)   if (general_isothermal) then
  2514)     Jup(GENERAL_ENERGY_EQUATION_INDEX,:) = 0.d0
  2515)     Jup(:,GENERAL_ENERGY_EQUATION_INDEX) = 0.d0
  2516)     Jdn(GENERAL_ENERGY_EQUATION_INDEX,:) = 0.d0
  2517)     Jdn(:,GENERAL_ENERGY_EQUATION_INDEX) = 0.d0
  2518)   endif
  2519)   
  2520)   if (general_no_air) then
  2521)     Jup(GENERAL_GAS_EQUATION_INDEX,:) = 0.d0
  2522)     Jup(:,GENERAL_GAS_EQUATION_INDEX) = 0.d0
  2523)     Jdn(GENERAL_GAS_EQUATION_INDEX,:) = 0.d0
  2524)     Jdn(:,GENERAL_GAS_EQUATION_INDEX) = 0.d0
  2525)   endif  
  2526) 
  2527) #ifdef DEBUG_GENERAL_FILEOUTPUT
  2528)   if (debug_flag > 0) then
  2529)     write(debug_unit,'(a,20es24.15)') 'flux deriv:', Jup, Jdn
  2530)   endif
  2531) #endif
  2532)   
  2533) end subroutine GeneralFluxDerivative
  2534) 
  2535) ! ************************************************************************** !
  2536) 
  2537) subroutine GeneralBCFluxDerivative(ibndtype,auxvar_mapping,auxvars, &
  2538)                                    gen_auxvar_up, &
  2539)                                    global_auxvar_up, &
  2540)                                    gen_auxvar_dn,global_auxvar_dn, &
  2541)                                    material_auxvar_dn, &
  2542)                                    sir_dn, &
  2543)                                    thermal_conductivity_dn, &
  2544)                                    area,dist,general_parameter, &
  2545)                                    option,Jdn)
  2546)   ! 
  2547)   ! Computes the derivatives of the boundary flux terms
  2548)   ! for the Jacobian
  2549)   ! 
  2550)   ! Author: Glenn Hammond
  2551)   ! Date: 03/09/11
  2552)   ! 
  2553) 
  2554)   use Option_module 
  2555)   use Material_Aux_class
  2556)   
  2557)   implicit none
  2558) 
  2559)   PetscReal :: auxvars(:) ! from aux_real_var array
  2560)   type(general_auxvar_type) :: gen_auxvar_up, gen_auxvar_dn(0:)
  2561)   type(global_auxvar_type) :: global_auxvar_up, global_auxvar_dn
  2562)   class(material_auxvar_type) :: material_auxvar_dn
  2563)   type(option_type) :: option
  2564)   PetscReal :: sir_dn(:)
  2565)   PetscReal :: area
  2566)   PetscReal :: dist(-1:3)
  2567)   type(general_parameter_type) :: general_parameter
  2568)   PetscReal :: Jdn(option%nflowdof,option%nflowdof)
  2569)   PetscInt :: ibndtype(1:option%nflowdof)
  2570)   PetscInt :: auxvar_mapping(GENERAL_MAX_INDEX)
  2571)   PetscReal :: thermal_conductivity_dn(2)
  2572) 
  2573)   PetscReal :: v_darcy(option%nphase)
  2574)   PetscReal :: res(option%nflowdof), res_pert(option%nflowdof)
  2575)   PetscInt :: idof, irow
  2576) 
  2577)   Jdn = 0.d0
  2578) !geh:print *, 'GeneralBCFluxDerivative'
  2579) 
  2580)   option%iflag = -2
  2581)   call GeneralBCFlux(ibndtype,auxvar_mapping,auxvars, &
  2582)                      gen_auxvar_up,global_auxvar_up, &
  2583)                      gen_auxvar_dn(ZERO_INTEGER),global_auxvar_dn, &
  2584)                      material_auxvar_dn, &
  2585)                      sir_dn, &
  2586)                      thermal_conductivity_dn, &
  2587)                      area,dist,general_parameter, &
  2588)                      option,v_darcy,res,PETSC_FALSE)                     
  2589)   ! downgradient derivatives
  2590)   do idof = 1, option%nflowdof
  2591)     call GeneralBCFlux(ibndtype,auxvar_mapping,auxvars, &
  2592)                        gen_auxvar_up,global_auxvar_up, &
  2593)                        gen_auxvar_dn(idof),global_auxvar_dn, &
  2594)                        material_auxvar_dn, &
  2595)                        sir_dn, &
  2596)                        thermal_conductivity_dn, &
  2597)                        area,dist,general_parameter, &
  2598)                        option,v_darcy,res_pert,PETSC_FALSE)   
  2599)     do irow = 1, option%nflowdof
  2600)       Jdn(irow,idof) = (res_pert(irow)-res(irow))/gen_auxvar_dn(idof)%pert
  2601) !print *, 'bc: ', irow, idof, Jdn(irow,idof), gen_auxvar_dn(idof)%pert
  2602)     enddo !irow
  2603)   enddo ! idof
  2604) 
  2605)   if (general_isothermal) then
  2606)     Jdn(GENERAL_ENERGY_EQUATION_INDEX,:) = 0.d0
  2607)     Jdn(:,GENERAL_ENERGY_EQUATION_INDEX) = 0.d0
  2608)   endif
  2609)   
  2610)   if (general_no_air) then
  2611)     Jdn(GENERAL_GAS_EQUATION_INDEX,:) = 0.d0
  2612)     Jdn(:,GENERAL_GAS_EQUATION_INDEX) = 0.d0
  2613)   endif  
  2614)   
  2615) #ifdef DEBUG_GENERAL_FILEOUTPUT
  2616)   if (debug_flag > 0) then
  2617)     write(debug_unit,'(a,10es24.15)') 'bc flux deriv:', Jdn
  2618)   endif
  2619) #endif
  2620)   
  2621) end subroutine GeneralBCFluxDerivative
  2622) 
  2623) ! ************************************************************************** !
  2624) 
  2625) subroutine GeneralSrcSinkDerivative(option,qsrc,flow_src_sink_type, &
  2626)                                     gen_auxvars,global_auxvar,scale,Jac)
  2627)   ! 
  2628)   ! Computes the source/sink terms for the residual
  2629)   ! 
  2630)   ! Author: Glenn Hammond
  2631)   ! Date: 03/09/11
  2632)   ! 
  2633) 
  2634)   use Option_module
  2635) 
  2636)   implicit none
  2637) 
  2638)   type(option_type) :: option
  2639)   PetscReal :: qsrc(:)
  2640)   PetscInt :: flow_src_sink_type
  2641)   type(general_auxvar_type) :: gen_auxvars(0:)
  2642)   type(global_auxvar_type) :: global_auxvar
  2643)   PetscReal :: scale
  2644)   PetscReal :: Jac(option%nflowdof,option%nflowdof)
  2645)   
  2646)   PetscReal :: res(option%nflowdof), res_pert(option%nflowdof)
  2647)   PetscReal :: dummy_real(option%nphase)
  2648)   PetscInt :: idof, irow
  2649) 
  2650)   option%iflag = -3
  2651)   call GeneralSrcSink(option,qsrc,flow_src_sink_type, &
  2652)                       gen_auxvars(ZERO_INTEGER),global_auxvar,dummy_real, &
  2653)                       scale,res,PETSC_FALSE)
  2654)   ! downgradient derivatives
  2655)   do idof = 1, option%nflowdof
  2656)     call GeneralSrcSink(option,qsrc,flow_src_sink_type, &
  2657)                         gen_auxvars(idof),global_auxvar,dummy_real, &
  2658)                         scale,res_pert,PETSC_FALSE)            
  2659)     do irow = 1, option%nflowdof
  2660)       Jac(irow,idof) = (res_pert(irow)-res(irow))/gen_auxvars(idof)%pert
  2661)     enddo !irow
  2662)   enddo ! idof
  2663)   
  2664)   if (general_isothermal) then
  2665)     Jac(GENERAL_ENERGY_EQUATION_INDEX,:) = 0.d0
  2666)     Jac(:,GENERAL_ENERGY_EQUATION_INDEX) = 0.d0
  2667)   endif
  2668)   
  2669)   if (general_no_air) then
  2670)     Jac(GENERAL_GAS_EQUATION_INDEX,:) = 0.d0
  2671)     Jac(:,GENERAL_GAS_EQUATION_INDEX) = 0.d0
  2672)   endif  
  2673)   
  2674) #ifdef DEBUG_GENERAL_FILEOUTPUT
  2675)   if (debug_flag > 0) then
  2676)     write(debug_unit,'(a,20es24.15)') 'src/sink deriv:', Jac
  2677)   endif
  2678) #endif
  2679) 
  2680) end subroutine GeneralSrcSinkDerivative
  2681) 
  2682) ! ************************************************************************** !
  2683) 
  2684) subroutine GeneralResidual(snes,xx,r,realization,ierr)
  2685)   ! 
  2686)   ! Computes the residual equation
  2687)   ! 
  2688)   ! Author: Glenn Hammond
  2689)   ! Date: 03/09/11
  2690)   ! 
  2691) 
  2692)   use Realization_Subsurface_class
  2693)   use Field_module
  2694)   use Patch_module
  2695)   use Discretization_module
  2696)   use Option_module
  2697) 
  2698)   use Connection_module
  2699)   use Grid_module
  2700)   use Coupler_module  
  2701)   use Debug_module
  2702)   use Material_Aux_class
  2703) 
  2704) !#define DEBUG_WITH_TECPLOT
  2705) #ifdef DEBUG_WITH_TECPLOT
  2706)   use Output_Tecplot_module
  2707) #endif
  2708) 
  2709)   implicit none
  2710) 
  2711)   SNES :: snes
  2712)   Vec :: xx
  2713)   Vec :: r
  2714)   type(realization_subsurface_type) :: realization
  2715)   PetscViewer :: viewer
  2716)   PetscErrorCode :: ierr
  2717)   
  2718)   Mat, parameter :: null_mat = 0
  2719)   type(discretization_type), pointer :: discretization
  2720)   type(grid_type), pointer :: grid
  2721)   type(patch_type), pointer :: patch
  2722)   type(option_type), pointer :: option
  2723)   type(field_type), pointer :: field
  2724)   type(coupler_type), pointer :: boundary_condition
  2725)   type(coupler_type), pointer :: source_sink
  2726)   type(material_parameter_type), pointer :: material_parameter
  2727)   type(general_parameter_type), pointer :: general_parameter
  2728)   type(general_auxvar_type), pointer :: gen_auxvars(:,:), gen_auxvars_bc(:)
  2729)   type(global_auxvar_type), pointer :: global_auxvars(:)
  2730)   type(global_auxvar_type), pointer :: global_auxvars_bc(:)
  2731)   type(global_auxvar_type), pointer :: global_auxvars_ss(:)
  2732)   class(material_auxvar_type), pointer :: material_auxvars(:)
  2733)   type(connection_set_list_type), pointer :: connection_set_list
  2734)   type(connection_set_type), pointer :: cur_connection_set
  2735) 
  2736)   PetscInt :: iconn
  2737)   PetscInt :: iphase
  2738)   PetscReal :: scale
  2739)   PetscReal :: ss_flow_vol_flux(realization%option%nphase)
  2740)   PetscInt :: sum_connection
  2741)   PetscInt :: local_start, local_end
  2742)   PetscInt :: local_id, ghosted_id
  2743)   PetscInt :: local_id_up, local_id_dn, ghosted_id_up, ghosted_id_dn
  2744)   PetscInt :: i, imat, imat_up, imat_dn
  2745)   PetscInt, save :: iplot = 0
  2746) 
  2747)   PetscReal, pointer :: r_p(:)
  2748)   PetscReal, pointer :: accum_p(:), accum_p2(:)
  2749)   
  2750)   character(len=MAXSTRINGLENGTH) :: string
  2751)   character(len=MAXWORDLENGTH) :: word
  2752) 
  2753)   PetscInt :: icap_up, icap_dn
  2754)   PetscReal :: Res(realization%option%nflowdof)
  2755)   PetscReal :: Jac_dummy(realization%option%nflowdof, &
  2756)                          realization%option%nflowdof)
  2757)   PetscReal :: v_darcy(realization%option%nphase)
  2758)   
  2759)   discretization => realization%discretization
  2760)   option => realization%option
  2761)   patch => realization%patch
  2762)   grid => patch%grid
  2763)   field => realization%field
  2764)   material_parameter => patch%aux%Material%material_parameter
  2765)   gen_auxvars => patch%aux%General%auxvars
  2766)   gen_auxvars_bc => patch%aux%General%auxvars_bc
  2767)   general_parameter => patch%aux%General%general_parameter
  2768)   global_auxvars => patch%aux%Global%auxvars
  2769)   global_auxvars_bc => patch%aux%Global%auxvars_bc
  2770)   global_auxvars_ss => patch%aux%Global%auxvars_ss
  2771)   material_auxvars => patch%aux%Material%auxvars
  2772)   
  2773) #ifdef DEBUG_GENERAL_FILEOUTPUT
  2774)   if (debug_flag > 0) then
  2775)     debug_iteration_count = debug_iteration_count + 1
  2776)     write(word,*) debug_timestep_count
  2777)     string = 'residual_debug_data_' // trim(adjustl(word))
  2778)     write(word,*) debug_timestep_cut_count
  2779)     string = trim(string) // '_' // trim(adjustl(word))
  2780)     write(word,*) debug_iteration_count
  2781)     debug_filename = trim(string) // '_' // trim(adjustl(word)) // '.txt'
  2782)     open(debug_unit, file=debug_filename, action="write", status="unknown")
  2783)     open(debug_info_unit, file='debug_info.txt', action="write", &
  2784)          position="append", status="unknown")
  2785)     write(debug_info_unit,*) 'residual ', debug_timestep_count, &
  2786)       debug_timestep_cut_count, debug_iteration_count
  2787)     close(debug_info_unit)
  2788)   endif
  2789) #endif
  2790) 
  2791)   ! Communication -----------------------------------------
  2792)   ! These 3 must be called before GeneralUpdateAuxVars()
  2793)   call DiscretizationGlobalToLocal(discretization,xx,field%flow_xx_loc,NFLOWDOF)
  2794)   
  2795)                                              ! do update state
  2796)   call GeneralUpdateAuxVars(realization,PETSC_TRUE)
  2797) 
  2798) ! for debugging a single grid cell
  2799) !  i = 6
  2800) !  call GeneralOutputAuxVars(gen_auxvars(0,i),global_auxvars(i),i,'genaux', &
  2801) !                            PETSC_TRUE,option)
  2802) #ifdef DEBUG_WITH_TECPLOT
  2803) ! for debugging entire solution over a single SNES solve
  2804)   write(word,*) iplot
  2805)   iplot = iplot + 1
  2806)   realization%output_option%plot_name = 'general-ni-' // trim(adjustl(word))
  2807)   call OutputTecplotPoint(realization)
  2808) #endif
  2809) 
  2810)   ! override flags since they will soon be out of date
  2811)   patch%aux%General%auxvars_up_to_date = PETSC_FALSE 
  2812) 
  2813)   ! always assume variables have been swapped; therefore, must copy back
  2814)   call VecLockPop(xx,ierr); CHKERRQ(ierr)
  2815)   call DiscretizationLocalToGlobal(discretization,field%flow_xx_loc,xx, &
  2816)                                    NFLOWDOF)
  2817)   call VecLockPush(xx,ierr); CHKERRQ(ierr)
  2818) 
  2819)   if (option%compute_mass_balance_new) then
  2820)     call GeneralZeroMassBalanceDelta(realization)
  2821)   endif
  2822) 
  2823)   option%iflag = 1
  2824)   ! now assign access pointer to local variables
  2825)   call VecGetArrayF90(r, r_p, ierr);CHKERRQ(ierr)
  2826) 
  2827)   ! Accumulation terms ------------------------------------
  2828)   ! accumulation at t(k) (doesn't change during Newton iteration)
  2829)   call VecGetArrayReadF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
  2830)   r_p = -accum_p
  2831) 
  2832)   
  2833)   !Heeho dynamically update p+1 accumulation term
  2834)   if (general_tough2_conv_criteria) then
  2835)     call VecGetArrayReadF90(field%flow_accum2, accum_p2, ierr);CHKERRQ(ierr)
  2836)   endif
  2837)   
  2838)   ! accumulation at t(k+1)
  2839)   do local_id = 1, grid%nlmax  ! For each local node do...
  2840)     ghosted_id = grid%nL2G(local_id)
  2841)     !geh - Ignore inactive cells with inactive materials
  2842)     imat = patch%imat(ghosted_id)
  2843)     if (imat <= 0) cycle
  2844)     local_end = local_id * option%nflowdof
  2845)     local_start = local_end - option%nflowdof + 1
  2846)     call GeneralAccumulation(gen_auxvars(ZERO_INTEGER,ghosted_id), &
  2847)                              global_auxvars(ghosted_id), &
  2848)                              material_auxvars(ghosted_id), &
  2849)                              material_parameter%soil_heat_capacity(imat), &
  2850)                              option,Res,Jac_dummy, &
  2851)                              general_analytical_derivatives, &
  2852)                              local_id == general_debug_cell_id) 
  2853)     r_p(local_start:local_end) =  r_p(local_start:local_end) + Res(:)
  2854)     
  2855)     !Heeho dynamically update p+1 accumulation term
  2856)     if (general_tough2_conv_criteria) then
  2857)       accum_p2(local_start:local_end) = Res(:)
  2858)     endif
  2859)     
  2860)   enddo
  2861) 
  2862)   call VecRestoreArrayReadF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
  2863)   !Heeho dynamically update p+1 accumulation term
  2864)   if (general_tough2_conv_criteria) then
  2865)     call VecRestoreArrayReadF90(field%flow_accum2, accum_p2, ierr);CHKERRQ(ierr)
  2866)   endif
  2867) 
  2868)   ! Interior Flux Terms -----------------------------------
  2869)   connection_set_list => grid%internal_connection_set_list
  2870)   cur_connection_set => connection_set_list%first
  2871)   sum_connection = 0  
  2872)   do 
  2873)     if (.not.associated(cur_connection_set)) exit
  2874)     do iconn = 1, cur_connection_set%num_connections
  2875)       sum_connection = sum_connection + 1
  2876) 
  2877)       ghosted_id_up = cur_connection_set%id_up(iconn)
  2878)       ghosted_id_dn = cur_connection_set%id_dn(iconn)
  2879) 
  2880)       local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
  2881)       local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping   
  2882) 
  2883)       imat_up = patch%imat(ghosted_id_up) 
  2884)       imat_dn = patch%imat(ghosted_id_dn) 
  2885)       if (imat_up <= 0 .or. imat_dn <= 0) cycle
  2886) 
  2887)       icap_up = patch%sat_func_id(ghosted_id_up)
  2888)       icap_dn = patch%sat_func_id(ghosted_id_dn)
  2889) 
  2890)       call GeneralFlux(gen_auxvars(ZERO_INTEGER,ghosted_id_up), &
  2891)                        global_auxvars(ghosted_id_up), &
  2892)                        material_auxvars(ghosted_id_up), &
  2893)                        material_parameter%soil_residual_saturation(:,icap_up), &
  2894)                        material_parameter%soil_thermal_conductivity(:,imat_up), &
  2895)                        gen_auxvars(ZERO_INTEGER,ghosted_id_dn), &
  2896)                        global_auxvars(ghosted_id_dn), &
  2897)                        material_auxvars(ghosted_id_dn), &
  2898)                        material_parameter%soil_residual_saturation(:,icap_dn), &
  2899)                        material_parameter%soil_thermal_conductivity(:,imat_dn), &
  2900)                        cur_connection_set%area(iconn), &
  2901)                        cur_connection_set%dist(:,iconn), &
  2902)                        general_parameter,option,v_darcy,Res, &
  2903)                        Jac_dummy,Jac_dummy, &
  2904)                        general_analytical_derivatives, &
  2905)                        (local_id_up == general_debug_cell_id .or. &
  2906)                         local_id_dn == general_debug_cell_id))
  2907) 
  2908)       patch%internal_velocities(:,sum_connection) = v_darcy
  2909)       if (associated(patch%internal_flow_fluxes)) then
  2910)         patch%internal_flow_fluxes(:,sum_connection) = Res(:)
  2911)       endif
  2912)       
  2913)       if (local_id_up > 0) then
  2914)         local_end = local_id_up * option%nflowdof
  2915)         local_start = local_end - option%nflowdof + 1
  2916)         r_p(local_start:local_end) = r_p(local_start:local_end) + Res(:)
  2917)       endif
  2918)          
  2919)       if (local_id_dn > 0) then
  2920)         local_end = local_id_dn * option%nflowdof
  2921)         local_start = local_end - option%nflowdof + 1
  2922)         r_p(local_start:local_end) = r_p(local_start:local_end) - Res(:)
  2923)       endif
  2924)     enddo
  2925) 
  2926)     cur_connection_set => cur_connection_set%next
  2927)   enddo    
  2928) 
  2929)   ! Boundary Flux Terms -----------------------------------
  2930)   boundary_condition => patch%boundary_condition_list%first
  2931)   sum_connection = 0    
  2932)   do 
  2933)     if (.not.associated(boundary_condition)) exit
  2934)     
  2935)     cur_connection_set => boundary_condition%connection_set
  2936)     
  2937)     do iconn = 1, cur_connection_set%num_connections
  2938)       sum_connection = sum_connection + 1
  2939)     
  2940)       local_id = cur_connection_set%id_dn(iconn)
  2941)       ghosted_id = grid%nL2G(local_id)
  2942) 
  2943)       imat_dn = patch%imat(ghosted_id)
  2944)       if (imat_dn <= 0) cycle
  2945) 
  2946)       if (ghosted_id<=0) then
  2947)         print *, "Wrong boundary node index... STOP!!!"
  2948)         stop
  2949)       endif
  2950) 
  2951)       icap_dn = patch%sat_func_id(ghosted_id)
  2952) 
  2953)       call GeneralBCFlux(boundary_condition%flow_bc_type, &
  2954)                      boundary_condition%flow_aux_mapping, &
  2955)                      boundary_condition%flow_aux_real_var(:,iconn), &
  2956)                      gen_auxvars_bc(sum_connection), &
  2957)                      global_auxvars_bc(sum_connection), &
  2958)                      gen_auxvars(ZERO_INTEGER,ghosted_id), &
  2959)                      global_auxvars(ghosted_id), &
  2960)                      material_auxvars(ghosted_id), &
  2961)                      material_parameter%soil_residual_saturation(:,icap_dn), &
  2962)                      material_parameter%soil_thermal_conductivity(:,imat_dn), &
  2963)                      cur_connection_set%area(iconn), &
  2964)                      cur_connection_set%dist(:,iconn), &
  2965)                      general_parameter,option, &
  2966)                      v_darcy,Res, &
  2967)                      local_id == general_debug_cell_id)
  2968)       patch%boundary_velocities(:,sum_connection) = v_darcy
  2969)       if (associated(patch%boundary_flow_fluxes)) then
  2970)         patch%boundary_flow_fluxes(:,sum_connection) = Res(:)
  2971)       endif
  2972)       if (option%compute_mass_balance_new) then
  2973)         ! contribution to boundary
  2974)         global_auxvars_bc(sum_connection)%mass_balance_delta(1:2,1) = &
  2975)           global_auxvars_bc(sum_connection)%mass_balance_delta(1:2,1) - &
  2976)           Res(1:2)
  2977)       endif
  2978) 
  2979)       local_end = local_id * option%nflowdof
  2980)       local_start = local_end - option%nflowdof + 1
  2981)       r_p(local_start:local_end)= r_p(local_start:local_end) - Res(:)
  2982) 
  2983)     enddo
  2984)     boundary_condition => boundary_condition%next
  2985)   enddo
  2986) 
  2987)   ! Source/sink terms -------------------------------------
  2988)   source_sink => patch%source_sink_list%first 
  2989)   sum_connection = 0
  2990)   do 
  2991)     if (.not.associated(source_sink)) exit
  2992)     
  2993)     cur_connection_set => source_sink%connection_set
  2994)     
  2995)     do iconn = 1, cur_connection_set%num_connections      
  2996)       sum_connection = sum_connection + 1
  2997)       local_id = cur_connection_set%id_dn(iconn)
  2998)       ghosted_id = grid%nL2G(local_id)
  2999)       if (patch%imat(ghosted_id) <= 0) cycle
  3000) 
  3001)       local_end = local_id * option%nflowdof
  3002)       local_start = local_end - option%nflowdof + 1
  3003) 
  3004)       if (associated(source_sink%flow_aux_real_var)) then
  3005)         scale = source_sink%flow_aux_real_var(ONE_INTEGER,iconn)
  3006)       else
  3007)         scale = 1.d0
  3008)       endif
  3009)       
  3010)       call GeneralSrcSink(option,source_sink%flow_condition%general%rate% &
  3011)                                   dataset%rarray(:), &
  3012)                         source_sink%flow_condition%general%rate%itype, &
  3013)                         gen_auxvars(ZERO_INTEGER,ghosted_id), &
  3014)                         global_auxvars(ghosted_id), &
  3015)                         ss_flow_vol_flux, &
  3016)                         scale,Res, &
  3017)                         local_id == general_debug_cell_id)
  3018) 
  3019)       r_p(local_start:local_end) =  r_p(local_start:local_end) - Res(:)
  3020) 
  3021)       if (associated(patch%ss_flow_vol_fluxes)) then
  3022)         patch%ss_flow_vol_fluxes(:,sum_connection) = ss_flow_vol_flux
  3023)       endif      
  3024)       if (associated(patch%ss_flow_fluxes)) then
  3025)         patch%ss_flow_fluxes(:,sum_connection) = Res(:)
  3026)       endif      
  3027)       if (option%compute_mass_balance_new) then
  3028)         ! contribution to boundary
  3029)         global_auxvars_ss(sum_connection)%mass_balance_delta(1:2,1) = &
  3030)           global_auxvars_ss(sum_connection)%mass_balance_delta(1:2,1) - &
  3031)           Res(1:2)
  3032)       endif
  3033) 
  3034)     enddo
  3035)     source_sink => source_sink%next
  3036)   enddo
  3037) 
  3038)   if (patch%aux%General%inactive_cells_exist) then
  3039)     do i=1,patch%aux%General%n_inactive_rows
  3040)       r_p(patch%aux%General%inactive_rows_local(i)) = 0.d0
  3041)     enddo
  3042)   endif
  3043)   
  3044)   call VecRestoreArrayF90(r, r_p, ierr);CHKERRQ(ierr)
  3045)   
  3046)   call GeneralSSSandbox(r,null_mat,PETSC_FALSE,grid,material_auxvars, &
  3047)                         gen_auxvars,option)
  3048) 
  3049)   if (Initialized(general_debug_cell_id)) then
  3050)     call VecGetArrayReadF90(r, r_p, ierr);CHKERRQ(ierr)
  3051)     do local_id = general_debug_cell_id-1, general_debug_cell_id+1
  3052)       write(*,'(''  residual   : '',i2,10es12.4)') local_id, &
  3053)         r_p((local_id-1)*option%nflowdof+1:(local_id-1)*option%nflowdof+2), &
  3054)         r_p(local_id*option%nflowdof)*1.d6
  3055)     enddo
  3056)     call VecRestoreArrayReadF90(r, r_p, ierr);CHKERRQ(ierr)
  3057)   endif
  3058)   
  3059)   if (general_isothermal) then
  3060)     call VecGetArrayF90(r, r_p, ierr);CHKERRQ(ierr)
  3061)     ! zero energy residual
  3062)     do local_id = 1, grid%nlmax
  3063)       r_p((local_id-1)*option%nflowdof+GENERAL_ENERGY_EQUATION_INDEX) =  0.d0
  3064)     enddo
  3065)     call VecRestoreArrayF90(r, r_p, ierr);CHKERRQ(ierr)
  3066)   endif
  3067)   if (general_no_air) then
  3068)     call VecGetArrayF90(r, r_p, ierr);CHKERRQ(ierr)
  3069)     ! zero energy residual
  3070)     do local_id = 1, grid%nlmax
  3071)       r_p((local_id-1)*option%nflowdof+GENERAL_GAS_EQUATION_INDEX) =  0.d0
  3072)     enddo
  3073)     call VecRestoreArrayF90(r, r_p, ierr);CHKERRQ(ierr)
  3074)   endif  
  3075) 
  3076) #ifdef DEBUG_GENERAL_FILEOUTPUT
  3077)   call VecGetArrayReadF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
  3078)   do local_id = 1, grid%nlmax
  3079)     write(debug_unit,'(a,i5,7es24.15)') 'fixed residual:', local_id, &
  3080)       accum_p((local_id-1)*option%nflowdof+1:local_id*option%nflowdof)
  3081)   enddo
  3082)   call VecRestoreArrayReadF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
  3083)   call VecGetArrayF90(r, r_p, ierr);CHKERRQ(ierr)
  3084)   do local_id = 1, grid%nlmax
  3085)     write(debug_unit,'(a,i5,7es24.15)') 'residual:', local_id, &
  3086)       r_p((local_id-1)*option%nflowdof+1:local_id*option%nflowdof)
  3087)   enddo
  3088)   call VecRestoreArrayF90(r, r_p, ierr);CHKERRQ(ierr)
  3089) #endif
  3090)   
  3091)   
  3092)   if (realization%debug%vecview_residual) then
  3093)     string = 'Gresidual'
  3094)     call DebugCreateViewer(realization%debug,string,option,viewer)
  3095)     call VecView(r,viewer,ierr);CHKERRQ(ierr)
  3096)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  3097)   endif
  3098)   if (realization%debug%vecview_solution) then
  3099)     string = 'Gxx'
  3100)     call DebugCreateViewer(realization%debug,string,option,viewer)
  3101)     call VecView(xx,viewer,ierr);CHKERRQ(ierr)
  3102)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  3103)   endif
  3104) 
  3105) #ifdef DEBUG_GENERAL_FILEOUTPUT
  3106)   if (debug_flag > 0) then
  3107)     close(debug_unit)
  3108)   endif
  3109) #endif
  3110)   
  3111) end subroutine GeneralResidual
  3112) 
  3113) ! ************************************************************************** !
  3114) 
  3115) subroutine GeneralJacobian(snes,xx,A,B,realization,ierr)
  3116)   ! 
  3117)   ! Computes the Jacobian
  3118)   ! 
  3119)   ! Author: Glenn Hammond
  3120)   ! Date: 03/09/11
  3121)   ! 
  3122) 
  3123)   use Realization_Subsurface_class
  3124)   use Patch_module
  3125)   use Grid_module
  3126)   use Option_module
  3127)   use Connection_module
  3128)   use Coupler_module
  3129)   use Field_module
  3130)   use Debug_module
  3131)   use Material_Aux_class
  3132) 
  3133)   implicit none
  3134) 
  3135)   SNES :: snes
  3136)   Vec :: xx
  3137)   Mat :: A, B
  3138)   type(realization_subsurface_type) :: realization
  3139)   PetscErrorCode :: ierr
  3140) 
  3141)   Mat :: J
  3142)   MatType :: mat_type
  3143)   PetscReal :: norm
  3144)   PetscViewer :: viewer
  3145) 
  3146)   PetscInt :: icap_up,icap_dn
  3147)   PetscReal :: qsrc, scale
  3148)   PetscInt :: imat, imat_up, imat_dn
  3149)   PetscInt :: local_id, ghosted_id, natural_id
  3150)   PetscInt :: irow
  3151)   PetscInt :: local_id_up, local_id_dn
  3152)   PetscInt :: ghosted_id_up, ghosted_id_dn
  3153)   Vec, parameter :: null_vec = 0
  3154)   
  3155)   PetscReal :: Jup(realization%option%nflowdof,realization%option%nflowdof), &
  3156)                Jdn(realization%option%nflowdof,realization%option%nflowdof)
  3157)   
  3158)   type(coupler_type), pointer :: boundary_condition, source_sink
  3159)   type(connection_set_list_type), pointer :: connection_set_list
  3160)   type(connection_set_type), pointer :: cur_connection_set
  3161)   PetscInt :: iconn
  3162)   PetscInt :: sum_connection  
  3163)   PetscReal :: distance, fraction_upwind
  3164)   PetscReal :: distance_gravity 
  3165)   PetscInt, pointer :: zeros(:)
  3166)   type(grid_type), pointer :: grid
  3167)   type(patch_type), pointer :: patch
  3168)   type(option_type), pointer :: option 
  3169)   type(field_type), pointer :: field 
  3170)   type(material_parameter_type), pointer :: material_parameter
  3171)   type(general_parameter_type), pointer :: general_parameter
  3172)   type(general_auxvar_type), pointer :: gen_auxvars(:,:), gen_auxvars_bc(:)
  3173)   type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:) 
  3174)   class(material_auxvar_type), pointer :: material_auxvars(:)
  3175)   
  3176)   character(len=MAXSTRINGLENGTH) :: string
  3177)   character(len=MAXWORDLENGTH) :: word
  3178)   
  3179)   patch => realization%patch
  3180)   grid => patch%grid
  3181)   option => realization%option
  3182)   field => realization%field
  3183)   material_parameter => patch%aux%Material%material_parameter
  3184)   gen_auxvars => patch%aux%General%auxvars
  3185)   gen_auxvars_bc => patch%aux%General%auxvars_bc
  3186)   general_parameter => patch%aux%General%general_parameter
  3187)   global_auxvars => patch%aux%Global%auxvars
  3188)   global_auxvars_bc => patch%aux%Global%auxvars_bc
  3189)   material_auxvars => patch%aux%Material%auxvars
  3190) 
  3191)   call MatGetType(A,mat_type,ierr);CHKERRQ(ierr)
  3192)   if (mat_type == MATMFFD) then
  3193)     J = B
  3194)     call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3195)     call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3196)   else
  3197)     J = A
  3198)   endif
  3199) 
  3200)   call MatZeroEntries(J,ierr);CHKERRQ(ierr)
  3201) 
  3202) #ifdef DEBUG_GENERAL_FILEOUTPUT
  3203)   if (debug_flag > 0) then
  3204)     write(word,*) debug_timestep_count
  3205)     string = 'jacobian_debug_data_' // trim(adjustl(word))
  3206)     write(word,*) debug_timestep_cut_count
  3207)     string = trim(string) // '_' // trim(adjustl(word))
  3208)     write(word,*) debug_iteration_count
  3209)     debug_filename = trim(string) // '_' // trim(adjustl(word)) // '.txt'
  3210)     open(debug_unit, file=debug_filename, action="write", status="unknown")
  3211)     open(debug_info_unit, file='debug_info.txt', action="write", &
  3212)          position="append", status="unknown")
  3213)     write(debug_info_unit,*) 'jacobian ', debug_timestep_count, &
  3214)       debug_timestep_cut_count, debug_iteration_count
  3215)     close(debug_info_unit)
  3216)   endif
  3217) #endif
  3218) 
  3219)   ! Perturb aux vars
  3220)   do ghosted_id = 1, grid%ngmax  ! For each local node do...
  3221)     if (patch%imat(ghosted_id) <= 0) cycle
  3222)     natural_id = grid%nG2A(ghosted_id)
  3223)     call GeneralAuxVarPerturb(gen_auxvars(:,ghosted_id), &
  3224)                               global_auxvars(ghosted_id), &
  3225)                               material_auxvars(ghosted_id), &
  3226)                               patch%characteristic_curves_array( &
  3227)                                 patch%sat_func_id(ghosted_id))%ptr, &
  3228)                               natural_id,option)
  3229)   enddo
  3230)   
  3231) #ifdef DEBUG_GENERAL_LOCAL
  3232)   call GeneralOutputAuxVars(gen_auxvars,global_auxvars,option)
  3233) #endif 
  3234) 
  3235)   ! Accumulation terms ------------------------------------
  3236)   do local_id = 1, grid%nlmax  ! For each local node do...
  3237)     ghosted_id = grid%nL2G(local_id)
  3238)     !geh - Ignore inactive cells with inactive materials
  3239)     imat = patch%imat(ghosted_id)
  3240)     if (imat <= 0) cycle
  3241)     call GeneralAccumDerivative(gen_auxvars(:,ghosted_id), &
  3242)                               global_auxvars(ghosted_id), &
  3243)                               material_auxvars(ghosted_id), &
  3244)                               material_parameter%soil_heat_capacity(imat), &
  3245)                               option, &
  3246)                               Jup) 
  3247)     call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jup, &
  3248)                                   ADD_VALUES,ierr);CHKERRQ(ierr)
  3249)   enddo
  3250) 
  3251)   if (realization%debug%matview_Jacobian_detailed) then
  3252)     call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3253)     call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3254)     string = 'jacobian_accum'
  3255)     call DebugCreateViewer(realization%debug,string,option,viewer)
  3256)     call MatView(A,viewer,ierr);CHKERRQ(ierr)
  3257)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  3258)   endif
  3259) 
  3260) 
  3261)   ! Interior Flux Terms -----------------------------------  
  3262)   connection_set_list => grid%internal_connection_set_list
  3263)   cur_connection_set => connection_set_list%first
  3264)   sum_connection = 0    
  3265)   do 
  3266)     if (.not.associated(cur_connection_set)) exit
  3267)     do iconn = 1, cur_connection_set%num_connections
  3268)       sum_connection = sum_connection + 1
  3269)     
  3270)       ghosted_id_up = cur_connection_set%id_up(iconn)
  3271)       ghosted_id_dn = cur_connection_set%id_dn(iconn)
  3272) 
  3273)       imat_up = patch%imat(ghosted_id_up)
  3274)       imat_dn = patch%imat(ghosted_id_dn)
  3275)       if (imat_up <= 0 .or. imat_dn <= 0) cycle
  3276) 
  3277)       local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
  3278)       local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping   
  3279)    
  3280)       icap_up = patch%sat_func_id(ghosted_id_up)
  3281)       icap_dn = patch%sat_func_id(ghosted_id_dn)
  3282)                               
  3283)       call GeneralFluxDerivative(gen_auxvars(:,ghosted_id_up), &
  3284)                      global_auxvars(ghosted_id_up), &
  3285)                      material_auxvars(ghosted_id_up), &
  3286)                      material_parameter%soil_residual_saturation(:,icap_up), &
  3287)                      material_parameter%soil_thermal_conductivity(:,imat_up), &
  3288)                      gen_auxvars(:,ghosted_id_dn), &
  3289)                      global_auxvars(ghosted_id_dn), &
  3290)                      material_auxvars(ghosted_id_dn), &
  3291)                      material_parameter%soil_residual_saturation(:,icap_dn), &
  3292)                      material_parameter%soil_thermal_conductivity(:,imat_dn), &
  3293)                      cur_connection_set%area(iconn), &
  3294)                      cur_connection_set%dist(:,iconn), &
  3295)                      general_parameter,option,&
  3296)                      Jup,Jdn)
  3297)       if (local_id_up > 0) then
  3298)         call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_up-1, &
  3299)                                       Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
  3300)         call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_dn-1, &
  3301)                                       Jdn,ADD_VALUES,ierr);CHKERRQ(ierr)
  3302)       endif
  3303)       if (local_id_dn > 0) then
  3304)         Jup = -Jup
  3305)         Jdn = -Jdn
  3306)         call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_dn-1, &
  3307)                                       Jdn,ADD_VALUES,ierr);CHKERRQ(ierr)
  3308)         call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_up-1, &
  3309)                                       Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
  3310)       endif
  3311)     enddo
  3312)     cur_connection_set => cur_connection_set%next
  3313)   enddo
  3314) 
  3315)   if (realization%debug%matview_Jacobian_detailed) then
  3316)     call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3317)     call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3318)     string = 'jacobian_flux'
  3319)     call DebugCreateViewer(realization%debug,string,option,viewer)
  3320)     call MatView(A,viewer,ierr);CHKERRQ(ierr)
  3321)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  3322)   endif
  3323) 
  3324)   ! Boundary Flux Terms -----------------------------------
  3325)   boundary_condition => patch%boundary_condition_list%first
  3326)   sum_connection = 0    
  3327)   do 
  3328)     if (.not.associated(boundary_condition)) exit
  3329)     
  3330)     cur_connection_set => boundary_condition%connection_set
  3331)     
  3332)     do iconn = 1, cur_connection_set%num_connections
  3333)       sum_connection = sum_connection + 1
  3334)     
  3335)       local_id = cur_connection_set%id_dn(iconn)
  3336)       ghosted_id = grid%nL2G(local_id)
  3337) 
  3338)       imat_dn = patch%imat(ghosted_id)
  3339)       if (imat_dn <= 0) cycle
  3340) 
  3341)       if (ghosted_id<=0) then
  3342)         print *, "Wrong boundary node index... STOP!!!"
  3343)         stop
  3344)       endif
  3345) 
  3346)       icap_dn = patch%sat_func_id(ghosted_id)
  3347) 
  3348)       call GeneralBCFluxDerivative(boundary_condition%flow_bc_type, &
  3349)                       boundary_condition%flow_aux_mapping, &
  3350)                       boundary_condition%flow_aux_real_var(:,iconn), &
  3351)                       gen_auxvars_bc(sum_connection), &
  3352)                       global_auxvars_bc(sum_connection), &
  3353)                       gen_auxvars(:,ghosted_id), &
  3354)                       global_auxvars(ghosted_id), &
  3355)                       material_auxvars(ghosted_id), &
  3356)                       material_parameter%soil_residual_saturation(:,icap_dn), &
  3357)                       material_parameter%soil_thermal_conductivity(:,imat_dn), &
  3358)                       cur_connection_set%area(iconn), &
  3359)                       cur_connection_set%dist(:,iconn), &
  3360)                       general_parameter,option, &
  3361)                       Jdn)
  3362) 
  3363)       Jdn = -Jdn
  3364)       call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jdn, &
  3365)                                     ADD_VALUES,ierr);CHKERRQ(ierr)
  3366)     enddo
  3367)     boundary_condition => boundary_condition%next
  3368)   enddo
  3369) 
  3370)   if (realization%debug%matview_Jacobian_detailed) then
  3371)     call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3372)     call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3373)     string = 'jacobian_bcflux'
  3374)     call DebugCreateViewer(realization%debug,string,option,viewer)
  3375)     call MatView(A,viewer,ierr);CHKERRQ(ierr)
  3376)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  3377)   endif
  3378) 
  3379)   ! Source/sinks
  3380)   source_sink => patch%source_sink_list%first 
  3381)   do 
  3382)     if (.not.associated(source_sink)) exit
  3383)     
  3384)     cur_connection_set => source_sink%connection_set
  3385)     
  3386)     do iconn = 1, cur_connection_set%num_connections      
  3387)       local_id = cur_connection_set%id_dn(iconn)
  3388)       ghosted_id = grid%nL2G(local_id)
  3389)       if (patch%imat(ghosted_id) <= 0) cycle
  3390) 
  3391)       if (associated(source_sink%flow_aux_real_var)) then
  3392)         scale = source_sink%flow_aux_real_var(ONE_INTEGER,iconn)
  3393)       else
  3394)         scale = 1.d0
  3395)       endif
  3396)       
  3397)       Jup = 0.d0
  3398)       call GeneralSrcSinkDerivative(option, &
  3399)                         source_sink%flow_condition%general%rate% &
  3400)                                   dataset%rarray(:), &
  3401)                         source_sink%flow_condition%general%rate%itype, &
  3402)                         gen_auxvars(:,ghosted_id), &
  3403)                         global_auxvars(ghosted_id), &
  3404)                         scale,Jup)
  3405) 
  3406)       call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jup, &
  3407)                                     ADD_VALUES,ierr);CHKERRQ(ierr)
  3408) 
  3409)     enddo
  3410)     source_sink => source_sink%next
  3411)   enddo
  3412)   
  3413)   call GeneralSSSandbox(null_vec,A,PETSC_TRUE,grid,material_auxvars, &
  3414)                         gen_auxvars,option)
  3415) 
  3416)   if (realization%debug%matview_Jacobian_detailed) then
  3417)     call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3418)     call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3419)     string = 'jacobian_srcsink'
  3420)     call DebugCreateViewer(realization%debug,string,option,viewer)
  3421)     call MatView(A,viewer,ierr);CHKERRQ(ierr)
  3422)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  3423)   endif
  3424)   
  3425)   call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3426)   call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3427) 
  3428)   ! zero out isothermal and inactive cells
  3429)   if (patch%aux%General%inactive_cells_exist) then
  3430)     qsrc = 1.d0 ! solely a temporary variable in this conditional
  3431)     call MatZeroRowsLocal(A,patch%aux%General%n_inactive_rows, &
  3432)                           patch%aux%General%inactive_rows_local_ghosted, &
  3433)                           qsrc,PETSC_NULL_OBJECT,PETSC_NULL_OBJECT, &
  3434)                           ierr);CHKERRQ(ierr)
  3435)   endif
  3436) 
  3437)   if (general_isothermal) then
  3438)     qsrc = 1.d0 ! solely a temporary variable in this conditional
  3439)     zeros => patch%aux%General%row_zeroing_array
  3440)     ! zero energy residual
  3441)     do local_id = 1, grid%nlmax
  3442)       ghosted_id = grid%nL2G(local_id)
  3443)       zeros(local_id) = (ghosted_id-1)*option%nflowdof+ &
  3444)                         GENERAL_ENERGY_EQUATION_INDEX - 1 ! zero-based
  3445)     enddo
  3446)     call MatZeroRowsLocal(A,grid%nlmax,zeros,qsrc,PETSC_NULL_OBJECT, &
  3447)                           PETSC_NULL_OBJECT,ierr);CHKERRQ(ierr)
  3448)   endif
  3449) 
  3450)   if (general_no_air) then
  3451)     qsrc = 1.d0 ! solely a temporary variable in this conditional
  3452)     zeros => patch%aux%General%row_zeroing_array
  3453)     ! zero gas component mass balance residual
  3454)     do local_id = 1, grid%nlmax
  3455)       ghosted_id = grid%nL2G(local_id)
  3456)       zeros(local_id) = (ghosted_id-1)*option%nflowdof+ &
  3457)                         GENERAL_GAS_EQUATION_INDEX - 1 ! zero-based
  3458)     enddo
  3459)     call MatZeroRowsLocal(A,grid%nlmax,zeros,qsrc,PETSC_NULL_OBJECT, &
  3460)                           PETSC_NULL_OBJECT,ierr);CHKERRQ(ierr)
  3461)   endif
  3462)   
  3463)   if (realization%debug%matview_Jacobian) then
  3464)     string = 'Gjacobian'
  3465)     call DebugCreateViewer(realization%debug,string,option,viewer)
  3466)     call MatView(J,viewer,ierr);CHKERRQ(ierr)
  3467)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  3468)   endif
  3469)   if (realization%debug%norm_Jacobian) then
  3470)     option => realization%option
  3471)     call MatNorm(J,NORM_1,norm,ierr);CHKERRQ(ierr)
  3472)     write(option%io_buffer,'("1 norm: ",es11.4)') norm
  3473)     call printMsg(option) 
  3474)     call MatNorm(J,NORM_FROBENIUS,norm,ierr);CHKERRQ(ierr)
  3475)     write(option%io_buffer,'("2 norm: ",es11.4)') norm
  3476)     call printMsg(option) 
  3477)     call MatNorm(J,NORM_INFINITY,norm,ierr);CHKERRQ(ierr)
  3478)     write(option%io_buffer,'("inf norm: ",es11.4)') norm
  3479)     call printMsg(option) 
  3480)   endif
  3481) 
  3482) !  call MatView(J,PETSC_VIEWER_STDOUT_WORLD,ierr)
  3483) 
  3484) #if 0
  3485)   imat = 1
  3486)   if (imat == 1) then
  3487)     call GeneralNumericalJacobianTest(xx,realization,J) 
  3488)   endif
  3489) #endif
  3490) 
  3491) #ifdef DEBUG_GENERAL_FILEOUTPUT
  3492)   if (debug_flag > 0) then
  3493)     write(word,*) debug_timestep_count
  3494)     string = 'jacobian_' // trim(adjustl(word))
  3495)     write(word,*) debug_timestep_cut_count
  3496)     string = trim(string) // '_' // trim(adjustl(word))
  3497)     write(word,*) debug_iteration_count
  3498)     string = trim(string) // '_' // trim(adjustl(word)) // '.out'
  3499)     call PetscViewerASCIIOpen(realization%option%mycomm,trim(string), &
  3500)                               viewer,ierr);CHKERRQ(ierr)
  3501)     call MatView(J,viewer,ierr);CHKERRQ(ierr)
  3502)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  3503)     close(debug_unit)
  3504)   endif
  3505) #endif
  3506) 
  3507) end subroutine GeneralJacobian
  3508) 
  3509) ! ************************************************************************** !
  3510) 
  3511) function GeneralGetTecplotHeader(realization,icolumn)
  3512)   ! 
  3513)   ! Returns General Lite contribution to
  3514)   ! Tecplot file header
  3515)   ! 
  3516)   ! Author: Glenn Hammond
  3517)   ! Date: 03/09/11
  3518)   ! 
  3519)   
  3520)   use Realization_Subsurface_class
  3521)   use Option_module
  3522)   use Field_module
  3523)     
  3524)   implicit none
  3525)   
  3526)   character(len=MAXSTRINGLENGTH) :: GeneralGetTecplotHeader
  3527)   type(realization_subsurface_type) :: realization
  3528)   PetscInt :: icolumn
  3529)   
  3530)   character(len=MAXSTRINGLENGTH) :: string, string2
  3531)   type(option_type), pointer :: option
  3532)   type(field_type), pointer :: field  
  3533)   PetscInt :: i
  3534) 
  3535)   option => realization%option
  3536)   field => realization%field
  3537)   
  3538)   string = ''
  3539)   
  3540)   if (icolumn > -1) then
  3541)     icolumn = icolumn + 1
  3542)     write(string2,'('',"'',i2,''-T [C]"'')') icolumn
  3543)   else
  3544)     write(string2,'('',"T [C]"'')')
  3545)   endif
  3546)   string = trim(string) // trim(string2)
  3547)   
  3548)   if (icolumn > -1) then
  3549)     icolumn = icolumn + 1
  3550)     write(string2,'('',"'',i2,''-P [Pa]"'')') icolumn
  3551)   else
  3552)     write(string2,'('',"P [Pa]"'')')
  3553)   endif
  3554)   string = trim(string) // trim(string2)
  3555)   
  3556)   if (icolumn > -1) then
  3557)     icolumn = icolumn + 1
  3558)     write(string2,'('',"'',i2,''-State"'')') icolumn
  3559)   else
  3560)     write(string2,'('',"State"'')')
  3561)   endif
  3562)   string = trim(string) // trim(string2)
  3563)   
  3564)   if (icolumn > -1) then
  3565)     icolumn = icolumn + 1
  3566)     write(string2,'('',"'',i2,''-Sat(l)"'')') icolumn
  3567)   else
  3568)     write(string2,'('',"Sat(l)"'')')
  3569)   endif
  3570)   string = trim(string) // trim(string2)
  3571) 
  3572)   if (icolumn > -1) then
  3573)     icolumn = icolumn + 1
  3574)     write(string2,'('',"'',i2,''-Sat(g)"'')') icolumn
  3575)   else
  3576)     write(string2,'('',"Sat(g)"'')')
  3577)   endif
  3578)   string = trim(string) // trim(string2)
  3579)     
  3580)   if (icolumn > -1) then
  3581)     icolumn = icolumn + 1
  3582)     write(string2,'('',"'',i2,''-Rho(l)"'')') icolumn
  3583)   else
  3584)     write(string2,'('',"Rho(l)"'')')
  3585)   endif
  3586)   string = trim(string) // trim(string2)
  3587) 
  3588)   if (icolumn > -1) then
  3589)     icolumn = icolumn + 1
  3590)     write(string2,'('',"'',i2,''-Rho(g)"'')') icolumn
  3591)   else
  3592)     write(string2,'('',"Rho(g)"'')')
  3593)   endif
  3594)   string = trim(string) // trim(string2)
  3595)     
  3596)   if (icolumn > -1) then
  3597)     icolumn = icolumn + 1
  3598)     write(string2,'('',"'',i2,''-U(l)"'')') icolumn
  3599)   else
  3600)     write(string2,'('',"U(l)"'')')
  3601)   endif
  3602)   string = trim(string) // trim(string2)
  3603) 
  3604)   if (icolumn > -1) then
  3605)     icolumn = icolumn + 1
  3606)     write(string2,'('',"'',i2,''-U(g)"'')') icolumn
  3607)   else
  3608)     write(string2,'('',"U(g)"'')')
  3609)   endif
  3610)   string = trim(string) // trim(string2)
  3611)   
  3612)   do i=1,option%nflowspec
  3613)     if (icolumn > -1) then
  3614)       icolumn = icolumn + 1
  3615)       write(string2,'('',"'',i2,''-Xl('',i2,'')"'')') icolumn, i
  3616)     else
  3617)       write(string2,'('',"Xl('',i2,'')"'')') i
  3618)     endif
  3619)     string = trim(string) // trim(string2)
  3620)   enddo
  3621) 
  3622)   do i=1,option%nflowspec
  3623)     if (icolumn > -1) then
  3624)       icolumn = icolumn + 1
  3625)       write(string2,'('',"'',i2,''-Xg('',i2,'')"'')') icolumn, i
  3626)     else
  3627)       write(string2,'('',"Xg('',i2,'')"'')') i
  3628)     endif
  3629)     string = trim(string) // trim(string2)
  3630)   enddo
  3631)  
  3632)   GeneralGetTecplotHeader = string
  3633) 
  3634) end function GeneralGetTecplotHeader
  3635) 
  3636) ! ************************************************************************** !
  3637) 
  3638) subroutine GeneralSetPlotVariables(realization,list)
  3639)   ! 
  3640)   ! Adds variables to be printed to list
  3641)   ! 
  3642)   ! Author: Glenn Hammond
  3643)   ! Date: 02/15/13
  3644)   ! 
  3645)   
  3646)   use Realization_Subsurface_class
  3647)   use Output_Aux_module
  3648)   use Variables_module
  3649)     
  3650)   implicit none
  3651)   
  3652)   type(realization_subsurface_type) :: realization
  3653)   type(output_variable_list_type), pointer :: list
  3654) 
  3655)   character(len=MAXWORDLENGTH) :: name, units
  3656)   type(output_variable_type), pointer :: output_variable
  3657) 
  3658)   if (associated(list%first)) then
  3659)     return
  3660)   endif
  3661)   
  3662)   name = 'Temperature'
  3663)   units = 'C'
  3664)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  3665)                                TEMPERATURE)
  3666) 
  3667)   name = 'Liquid Pressure'
  3668)   units = 'Pa'
  3669)   call OutputVariableAddToList(list,name,OUTPUT_PRESSURE,units, &
  3670)                                LIQUID_PRESSURE)
  3671) 
  3672)   name = 'Gas Pressure'
  3673)   units = 'Pa'
  3674)   call OutputVariableAddToList(list,name,OUTPUT_PRESSURE,units, &
  3675)                                GAS_PRESSURE)
  3676) 
  3677)   name = 'Liquid Saturation'
  3678)   units = ''
  3679)   call OutputVariableAddToList(list,name,OUTPUT_SATURATION,units, &
  3680)                                LIQUID_SATURATION)
  3681)   
  3682)   name = 'Gas Saturation'
  3683)   units = ''
  3684)   call OutputVariableAddToList(list,name,OUTPUT_SATURATION,units, &
  3685)                                GAS_SATURATION)
  3686)   
  3687)   name = 'Liquid Density'
  3688)   units = 'kg/m^3'
  3689)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  3690)                                LIQUID_DENSITY)
  3691)   
  3692)   name = 'Gas Density'
  3693)   units = 'kg/m^3'
  3694)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  3695)                                GAS_DENSITY)
  3696)   
  3697)   name = 'X_g^l'
  3698)   units = ''
  3699)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  3700)                                LIQUID_MOLE_FRACTION, &
  3701)                                realization%option%air_id)
  3702)   
  3703)   name = 'X_l^l'
  3704)   units = ''
  3705)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  3706)                                LIQUID_MOLE_FRACTION, &
  3707)                                realization%option%water_id)
  3708)   
  3709)   name = 'X_g^g'
  3710)   units = ''
  3711)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  3712)                                GAS_MOLE_FRACTION, &
  3713)                                realization%option%air_id)
  3714)   
  3715)   name = 'X_l^g'
  3716)   units = ''
  3717)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  3718)                                GAS_MOLE_FRACTION, &
  3719)                                realization%option%water_id)
  3720)   
  3721)   name = 'Liquid Energy'
  3722)   units = 'MJ/kmol'
  3723)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  3724)                                LIQUID_ENERGY)
  3725)   
  3726)   name = 'Gas Energy'
  3727)   units = 'MJ/kmol'
  3728)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  3729)                                GAS_ENERGY)
  3730)   
  3731)   name = 'Thermodynamic State'
  3732)   units = ''
  3733)   output_variable => OutputVariableCreate(name,OUTPUT_DISCRETE,units,STATE)
  3734)   output_variable%plot_only = PETSC_TRUE ! toggle output off for observation
  3735)   output_variable%iformat = 1 ! integer
  3736)   call OutputVariableAddToList(list,output_variable)   
  3737)   
  3738) end subroutine GeneralSetPlotVariables
  3739) 
  3740) ! ************************************************************************** !
  3741) 
  3742) function GeneralAverageDensity(iphase,istate_up,istate_dn, &
  3743)                                density_up,density_dn,dden_up,dden_dn)
  3744)   ! 
  3745)   ! Averages density, using opposite cell density if phase non-existent
  3746)   ! 
  3747)   ! Author: Glenn Hammond
  3748)   ! Date: 03/07/14
  3749)   ! 
  3750) 
  3751)   implicit none
  3752) 
  3753)   PetscInt :: iphase
  3754)   PetscInt :: istate_up, istate_dn
  3755)   PetscReal :: density_up(:), density_dn(:)
  3756)   PetscReal :: dden_up, dden_dn
  3757) 
  3758)   PetscReal :: GeneralAverageDensity
  3759) 
  3760)   dden_up = 0.d0
  3761)   dden_dn = 0.d0
  3762)   if (iphase == LIQUID_PHASE) then
  3763)     if (istate_up == GAS_STATE) then
  3764)       GeneralAverageDensity = density_dn(iphase)
  3765)       dden_dn = 1.d0
  3766)     else if (istate_dn == GAS_STATE) then
  3767)       GeneralAverageDensity = density_up(iphase)
  3768)       dden_up = 1.d0
  3769)     else
  3770)       GeneralAverageDensity = 0.5d0*(density_up(iphase)+density_dn(iphase))
  3771)       dden_up = 0.5d0
  3772)       dden_dn = 0.5d0
  3773)     endif
  3774)   else if (iphase == GAS_PHASE) then
  3775)     if (istate_up == LIQUID_STATE) then
  3776)       GeneralAverageDensity = density_dn(iphase)
  3777)       dden_dn = 1.d0      
  3778)     else if (istate_dn == LIQUID_STATE) then
  3779)       GeneralAverageDensity = density_up(iphase)
  3780)       dden_up = 1.d0      
  3781)     else
  3782)       GeneralAverageDensity = 0.5d0*(density_up(iphase)+density_dn(iphase))
  3783)       dden_up = 0.5d0
  3784)       dden_dn = 0.5d0      
  3785)     endif
  3786)   endif
  3787) 
  3788) end function GeneralAverageDensity
  3789) 
  3790) ! ************************************************************************** !
  3791) 
  3792) subroutine GeneralSSSandbox(residual,Jacobian,compute_derivative, &
  3793)                             grid,material_auxvars,general_auxvars,option)
  3794)   ! 
  3795)   ! Evaluates source/sink term storing residual and/or Jacobian
  3796)   ! 
  3797)   ! Author: Glenn Hammond
  3798)   ! Date: 04/11/14
  3799)   ! 
  3800) 
  3801)   use Option_module
  3802)   use Grid_module
  3803)   use Material_Aux_class, only: material_auxvar_type
  3804)   use SrcSink_Sandbox_module
  3805)   use SrcSink_Sandbox_Base_class
  3806)   
  3807)   implicit none
  3808)   
  3809) #include "petsc/finclude/petscvec.h"
  3810) #include "petsc/finclude/petscvec.h90"
  3811) #include "petsc/finclude/petscmat.h"
  3812) #include "petsc/finclude/petscmat.h90"
  3813) 
  3814)   PetscBool :: compute_derivative
  3815)   Vec :: residual
  3816)   Mat :: Jacobian
  3817)   class(material_auxvar_type), pointer :: material_auxvars(:)
  3818)   type(general_auxvar_type), pointer :: general_auxvars(:,:)
  3819)   
  3820)   type(grid_type) :: grid
  3821)   type(option_type) :: option
  3822)   
  3823)   PetscReal, pointer :: r_p(:)
  3824)   PetscReal :: res(option%nflowdof)
  3825)   PetscReal :: Jac(option%nflowdof,option%nflowdof)
  3826)   class(srcsink_sandbox_base_type), pointer :: cur_srcsink
  3827)   PetscInt :: local_id, ghosted_id, istart, iend, irow, idof
  3828)   PetscReal :: res_pert(option%nflowdof)
  3829)   PetscReal :: aux_real(10)
  3830)   PetscErrorCode :: ierr
  3831)   
  3832)   if (.not.compute_derivative) then
  3833)     call VecGetArrayF90(residual,r_p,ierr);CHKERRQ(ierr)
  3834)   endif
  3835)   
  3836)   cur_srcsink => ss_sandbox_list
  3837)   do
  3838)     if (.not.associated(cur_srcsink)) exit
  3839)     aux_real = 0.d0
  3840)     local_id = cur_srcsink%local_cell_id
  3841)     ghosted_id = grid%nL2G(local_id)
  3842)     res = 0.d0
  3843)     Jac = 0.d0
  3844)     call GeneralSSSandboxLoadAuxReal(cur_srcsink,aux_real, &
  3845)                       general_auxvars(ZERO_INTEGER,ghosted_id),option)
  3846)     call cur_srcsink%Evaluate(res,Jac,PETSC_FALSE, &
  3847)                               material_auxvars(ghosted_id), &
  3848)                               aux_real,option)
  3849)     if (compute_derivative) then
  3850)       do idof = 1, option%nflowdof
  3851)         res_pert = 0.d0
  3852)         call GeneralSSSandboxLoadAuxReal(cur_srcsink,aux_real, &
  3853)                                     general_auxvars(idof,ghosted_id),option)
  3854)         call cur_srcsink%Evaluate(res_pert,Jac,PETSC_FALSE, &
  3855)                                   material_auxvars(ghosted_id), &
  3856)                                   aux_real,option)
  3857)         do irow = 1, option%nflowdof
  3858)           Jac(irow,idof) = (res_pert(irow)-res(irow)) / &
  3859)                             general_auxvars(idof,ghosted_id)%pert
  3860)         enddo
  3861)       enddo
  3862)       if (general_isothermal) then
  3863)         Jac(GENERAL_ENERGY_EQUATION_INDEX,:) = 0.d0
  3864)         Jac(:,GENERAL_ENERGY_EQUATION_INDEX) = 0.d0
  3865)       endif         
  3866)       if (general_no_air) then
  3867)         Jac(GENERAL_GAS_EQUATION_INDEX,:) = 0.d0
  3868)         Jac(:,GENERAL_GAS_EQUATION_INDEX) = 0.d0
  3869)       endif          
  3870)       call MatSetValuesBlockedLocal(Jacobian,1,ghosted_id-1,1, &
  3871)                                     ghosted_id-1,Jac,ADD_VALUES, &
  3872)                                     ierr);CHKERRQ(ierr)
  3873)     else
  3874)       iend = local_id*option%nflowdof
  3875)       istart = iend - option%nflowdof + 1
  3876)       r_p(istart:iend) = r_p(istart:iend) - res
  3877)     endif
  3878)     cur_srcsink => cur_srcsink%next
  3879)   enddo
  3880)   
  3881)   if (.not.compute_derivative) then
  3882)     call VecRestoreArrayF90(residual,r_p,ierr);CHKERRQ(ierr)
  3883)   endif
  3884) 
  3885) end subroutine GeneralSSSandbox
  3886) 
  3887) ! ************************************************************************** !
  3888) 
  3889) subroutine GeneralSSSandboxLoadAuxReal(srcsink,aux_real,gen_auxvar,option)
  3890) 
  3891)   use Option_module
  3892)   use SrcSink_Sandbox_Base_class
  3893)   use SrcSink_Sandbox_WIPP_Gas_class
  3894)   use SrcSink_Sandbox_WIPP_Well_class
  3895) 
  3896)   implicit none
  3897) 
  3898)   class(srcsink_sandbox_base_type) :: srcsink
  3899)   PetscReal :: aux_real(:)
  3900)   type(general_auxvar_type) gen_auxvar
  3901)   type(option_type) :: option
  3902)   
  3903)   aux_real = 0.d0
  3904)   select type(srcsink)
  3905)     class is(srcsink_sandbox_wipp_gas_type)
  3906)       aux_real(WIPP_GAS_WATER_SATURATION_INDEX) = &
  3907)         gen_auxvar%sat(option%liquid_phase)
  3908)       aux_real(WIPP_GAS_TEMPERATURE_INDEX) = &
  3909)         gen_auxvar%temp
  3910)     class is(srcsink_sandbox_wipp_well_type)
  3911)       aux_real(WIPP_WELL_LIQUID_MOBILITY) = &
  3912)         gen_auxvar%mobility(option%liquid_phase)
  3913)       aux_real(WIPP_WELL_GAS_MOBILITY) = &
  3914)         gen_auxvar%mobility(option%gas_phase)
  3915)       aux_real(WIPP_WELL_LIQUID_PRESSURE) = &
  3916)         gen_auxvar%pres(option%liquid_phase)
  3917)       aux_real(WIPP_WELL_GAS_PRESSURE) = &
  3918)         gen_auxvar%pres(option%gas_phase)
  3919)       aux_real(WIPP_WELL_LIQUID_ENTHALPY) = &
  3920)         gen_auxvar%H(option%liquid_phase)
  3921)       aux_real(WIPP_WELL_GAS_ENTHALPY) = &
  3922)         gen_auxvar%H(option%gas_phase)
  3923)       aux_real(WIPP_WELL_XMOL_AIR_IN_LIQUID) = &
  3924)         gen_auxvar%xmol(option%air_id,option%liquid_phase)
  3925)       aux_real(WIPP_WELL_XMOL_WATER_IN_GAS) = &
  3926)         gen_auxvar%xmol(option%water_id,option%gas_phase)
  3927)       aux_real(WIPP_WELL_LIQUID_DENSITY) = &
  3928)         gen_auxvar%den(option%liquid_phase)
  3929)       aux_real(WIPP_WELL_GAS_DENSITY) = &
  3930)         gen_auxvar%den(option%gas_phase)
  3931)   end select
  3932)   
  3933) end subroutine GeneralSSSandboxLoadAuxReal
  3934) 
  3935) ! ************************************************************************** !
  3936) 
  3937) subroutine GeneralMapBCAuxVarsToGlobal(realization)
  3938)   ! 
  3939)   ! Deallocates variables associated with Richard
  3940)   ! 
  3941)   ! Author: Glenn Hammond
  3942)   ! Date: 03/09/11
  3943)   ! 
  3944) 
  3945)   use Realization_Subsurface_class
  3946)   use Option_module
  3947)   use Patch_module
  3948)   use Coupler_module
  3949)   use Connection_module
  3950) 
  3951)   implicit none
  3952) 
  3953)   type(realization_subsurface_type) :: realization
  3954)   
  3955)   type(option_type), pointer :: option
  3956)   type(patch_type), pointer :: patch
  3957)   type(coupler_type), pointer :: boundary_condition
  3958)   type(connection_set_type), pointer :: cur_connection_set
  3959)   type(general_auxvar_type), pointer :: gen_auxvars_bc(:)  
  3960)   type(global_auxvar_type), pointer :: global_auxvars_bc(:)  
  3961) 
  3962)   PetscInt :: sum_connection, iconn
  3963)   
  3964)   option => realization%option
  3965)   patch => realization%patch
  3966) 
  3967)   if (option%ntrandof == 0) return ! no need to update
  3968)   
  3969)   gen_auxvars_bc => patch%aux%General%auxvars_bc
  3970)   global_auxvars_bc => patch%aux%Global%auxvars_bc
  3971)   
  3972)   boundary_condition => patch%boundary_condition_list%first
  3973)   sum_connection = 0    
  3974)   do 
  3975)     if (.not.associated(boundary_condition)) exit
  3976)     cur_connection_set => boundary_condition%connection_set
  3977)     do iconn = 1, cur_connection_set%num_connections
  3978)       sum_connection = sum_connection + 1
  3979)       global_auxvars_bc(sum_connection)%sat = &
  3980)         gen_auxvars_bc(sum_connection)%sat
  3981)       global_auxvars_bc(sum_connection)%den_kg = &
  3982)         gen_auxvars_bc(sum_connection)%den_kg
  3983)       global_auxvars_bc(sum_connection)%temp = &
  3984)         gen_auxvars_bc(sum_connection)%temp
  3985)     enddo
  3986)     boundary_condition => boundary_condition%next
  3987)   enddo
  3988)   
  3989) end subroutine GeneralMapBCAuxVarsToGlobal
  3990) 
  3991) ! ************************************************************************** !
  3992) 
  3993) subroutine GeneralDestroy(realization)
  3994)   ! 
  3995)   ! Deallocates variables associated with Richard
  3996)   ! 
  3997)   ! Author: Glenn Hammond
  3998)   ! Date: 03/09/11
  3999)   ! 
  4000) 
  4001)   use Realization_Subsurface_class
  4002) 
  4003)   implicit none
  4004) 
  4005)   type(realization_subsurface_type) :: realization
  4006)   
  4007)   ! place anything that needs to be freed here.
  4008)   ! auxvars are deallocated in auxiliary.F90.
  4009) 
  4010) end subroutine GeneralDestroy
  4011) 
  4012) end module General_module

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