toil_ims.F90       coverage:  82.61 %func     57.85 %block


     1) module TOilIms_module
     2) ! Brief description for the module
     3) ! Pimary variables for ToilIms: oil_pressure, oil_saturation, temperature
     4) 
     5)   use TOilIms_Aux_module
     6)   use Global_Aux_module
     7) 
     8)   use PFLOTRAN_Constants_module
     9) 
    10)   implicit none
    11)   
    12)   private 
    13) 
    14) #include "petsc/finclude/petscsys.h"
    15) #include "petsc/finclude/petscvec.h"
    16) #include "petsc/finclude/petscvec.h90"
    17) #include "petsc/finclude/petscmat.h"
    18) #include "petsc/finclude/petscmat.h90"
    19) #include "petsc/finclude/petscsnes.h"
    20) #include "petsc/finclude/petscviewer.h"
    21) #include "petsc/finclude/petsclog.h"
    22) 
    23) #define TOIL_CONVECTION
    24) #define TOIL_CONDUCTION
    25) 
    26) ! Cutoff parameters - no public
    27)   PetscReal, parameter :: eps       = 1.d-8
    28)   PetscReal, parameter :: floweps   = 1.d-24
    29) 
    30)   public :: TOilImsSetup, &
    31)             TOilImsUpdateAuxVars, &
    32)             TOilImsInitializeTimestep, &
    33)             TOilImsComputeMassBalance, &
    34)             TOilImsResidual, &
    35)             ToilImsJacobian, &
    36)             TOilImsUpdateSolution, &
    37)             TOilImsTimeCut, &
    38)             TOilImsMapBCAuxVarsToGlobal, &
    39)             !TOilImsCheckUpdatePre, &
    40)             !TOilImsCheckUpdatePost, &
    41)             TOilImsDestroy
    42) 
    43) contains
    44) 
    45) ! ************************************************************************** !
    46) 
    47) subroutine TOilImsSetup(realization)
    48)   ! 
    49)   ! Creates arrays for auxiliary variables
    50)   ! 
    51)   ! Author: Paolo Orsini (OGS)
    52)   ! Date: 10/20/15
    53)   ! 
    54) 
    55)   use Realization_Subsurface_class
    56)   use Patch_module
    57)   use Option_module
    58)   use Coupler_module
    59)   use Connection_module
    60)   use Grid_module
    61)   !use Fluid_module
    62)   use Material_Aux_class
    63)   use Output_Aux_module
    64)  
    65)   implicit none
    66)   
    67)   type(realization_subsurface_type) :: realization
    68) 
    69)   type(option_type), pointer :: option
    70)   type(patch_type),pointer :: patch
    71)   type(grid_type), pointer :: grid
    72)   type(coupler_type), pointer :: boundary_condition
    73)   type(material_parameter_type), pointer :: material_parameter
    74)   type(output_variable_list_type), pointer :: list
    75) 
    76)   PetscInt :: ghosted_id, iconn, sum_connection, local_id
    77)   PetscInt :: i, idof, count
    78)   PetscBool :: error_found
    79)   PetscInt :: flag(10)
    80)                                                 ! extra index for derivatives
    81)   type(toil_ims_auxvar_type), pointer :: toil_auxvars(:,:)
    82)   type(toil_ims_auxvar_type), pointer :: toil_auxvars_bc(:)
    83)   type(toil_ims_auxvar_type), pointer :: toil_auxvars_ss(:)
    84)   class(material_auxvar_type), pointer :: material_auxvars(:)
    85)   !type(fluid_property_type), pointer :: cur_fluid_property
    86)   
    87)   option => realization%option
    88)   patch => realization%patch
    89)   grid => patch%grid
    90)   
    91)   patch%aux%TOil_ims => TOilImsAuxCreate(option)
    92) 
    93)   ! ensure that material properties specific to this module are properly
    94)   ! initialized
    95)   material_parameter => patch%aux%Material%material_parameter
    96)   error_found = PETSC_FALSE
    97) 
    98)   if (minval(material_parameter%soil_residual_saturation(:,:)) < 0.d0) then
    99)     option%io_buffer = 'Non-initialized soil residual saturation.'
   100)     call printMsg(option)
   101)     error_found = PETSC_TRUE
   102)   endif
   103)   if (minval(material_parameter%soil_heat_capacity(:)) < 0.d0) then
   104)     option%io_buffer = 'Non-initialized soil heat capacity.'
   105)     call printMsg(option)
   106)     error_found = PETSC_TRUE
   107)   endif
   108)   if (minval(material_parameter%soil_thermal_conductivity(:,:)) < 0.d0) then
   109)     option%io_buffer = 'Non-initialized soil thermal conductivity.'
   110)     call printMsg(option)
   111)     error_found = PETSC_TRUE
   112)   endif
   113)   
   114)   material_auxvars => patch%aux%Material%auxvars
   115)   flag = 0
   116) 
   117)   !TODO(geh): change to looping over ghosted ids once the legacy code is 
   118)   !           history and the communicator can be passed down.
   119)   do local_id = 1, grid%nlmax
   120)     ghosted_id = grid%nL2G(local_id)
   121)     if (patch%imat(ghosted_id) <= 0) cycle
   122)     if (material_auxvars(ghosted_id)%volume < 0.d0 .and. flag(1) == 0) then
   123)       flag(1) = 1
   124)       option%io_buffer = 'Non-initialized cell volume.'
   125)       call printMsg(option)
   126)     endif
   127)     if (material_auxvars(ghosted_id)%porosity < 0.d0 .and. flag(2) == 0) then
   128)       flag(2) = 1
   129)       option%io_buffer = 'Non-initialized porosity.'
   130)       call printMsg(option)
   131)     endif
   132)     if (material_auxvars(ghosted_id)%tortuosity < 0.d0 .and. flag(3) == 0) then
   133)       flag(3) = 1
   134)       option%io_buffer = 'Non-initialized tortuosity.'
   135)       call printMsg(option)
   136)     endif
   137)     if (material_auxvars(ghosted_id)%soil_particle_density < 0.d0 .and. &
   138)         flag(4) == 0) then
   139)       flag(4) = 1
   140)       option%io_buffer = 'Non-initialized soil particle density.'
   141)       call printMsg(option)
   142)     endif
   143)     if (minval(material_auxvars(ghosted_id)%permeability) < 0.d0 .and. &
   144)         flag(5) == 0) then
   145)       option%io_buffer = 'Non-initialized permeability.'
   146)       call printMsg(option)
   147)       flag(5) = 1
   148)     endif
   149)   enddo
   150) 
   151)   if (error_found .or. maxval(flag) > 0) then
   152)     option%io_buffer = 'Material property errors found in TOilImsSetup.'
   153)     call printErrMsg(option)
   154)   endif
   155) 
   156)   ! allocate auxvar data structures for all grid cells  
   157)   allocate(toil_auxvars(0:option%nflowdof,grid%ngmax))
   158)   do ghosted_id = 1, grid%ngmax
   159)     do idof = 0, option%nflowdof
   160)       !call GeneralAuxVarInit(gen_auxvars(idof,ghosted_id),option)
   161)       call TOilImsAuxVarInit(toil_auxvars(idof,ghosted_id),option)
   162)     enddo
   163)   enddo
   164)   patch%aux%TOil_ims%auxvars => toil_auxvars
   165)   patch%aux%TOil_ims%num_aux = grid%ngmax
   166) 
   167)   ! count the number of boundary connections and allocate
   168)   ! auxvar data structures for them 
   169)   sum_connection = CouplerGetNumConnectionsInList(patch%boundary_condition_list)
   170)   if (sum_connection > 0) then
   171)     allocate(toil_auxvars_bc(sum_connection))
   172)     do iconn = 1, sum_connection
   173)       call TOilImsAuxVarInit(toil_auxvars_bc(iconn),option)
   174)     enddo
   175)     patch%aux%TOil_ims%auxvars_bc => toil_auxvars_bc
   176)   endif
   177)   patch%aux%TOil_ims%num_aux_bc = sum_connection
   178) 
   179)   ! count the number of source/sink connections and allocate
   180)   ! auxvar data structures for them  
   181)   sum_connection = CouplerGetNumConnectionsInList(patch%source_sink_list)
   182)   if (sum_connection > 0) then
   183)     allocate(toil_auxvars_ss(sum_connection))
   184)     do iconn = 1, sum_connection
   185)       call TOilImsAuxVarInit(toil_auxvars_ss(iconn),option)
   186)     enddo
   187)     patch%aux%TOil_ims%auxvars_ss => toil_auxvars_ss
   188)   endif
   189)   patch%aux%TOil_ims%num_aux_ss = sum_connection
   190) 
   191)   ! create array for zeroing Jacobian entries if isothermal
   192)   allocate(patch%aux%TOil_ims%row_zeroing_array(grid%nlmax))
   193)   patch%aux%TOil_ims%row_zeroing_array = 0
   194) 
   195)   list => realization%output_option%output_snap_variable_list
   196)   call TOilImsSetPlotVariables(list)
   197)   list => realization%output_option%output_obs_variable_list
   198)   call TOilImsSetPlotVariables(list)
   199)  
   200)   ! covergence creteria to be chosen (can use TOUGH or general type) 
   201)   !if (general_tough2_conv_criteria .and. &
   202)   !    Initialized(option%flow%inf_scaled_res_tol)) then
   203)   !  ! override what was set in OPTION block of GENERAL process model
   204)   !  general_tough2_itol_scaled_res_e1 = option%flow%inf_scaled_res_tol
   205)   !endif
   206) 
   207) end subroutine TOilImsSetup
   208) 
   209) ! ************************************************************************** !
   210) 
   211) subroutine TOilImsInitializeTimestep(realization)
   212)   ! 
   213)   ! Update data in module prior to time step
   214)   ! 
   215)   ! Author: Paolo Orsini (OGS)
   216)   ! Date: 10/20/15
   217)   ! 
   218) 
   219)   use Realization_Subsurface_class
   220)   
   221)   implicit none
   222)   
   223)   type(realization_subsurface_type) :: realization
   224) 
   225)   call TOilImsUpdateFixedAccum(realization)
   226)   
   227) 
   228) end subroutine TOilImsInitializeTimestep
   229) 
   230) ! ************************************************************************** !
   231) ! this is now defined in pm_toil_ims 
   232) !subroutine TOilImsCheckUpdatePre(line_search,X,dX,changed,realization,ierr)
   233) !  ! 
   234) !  ! Checks update prior to update
   235) !  ! 
   236) !  ! Author: Paolo Orsini (OGS)
   237) !  ! Date: 10/22/15
   238) !  !
   239) !
   240) !  use Realization_Subsurface_class
   241) !  use Grid_module
   242) !  use Field_module
   243) !  use Option_module
   244) !  !use Saturation_Function_module
   245) !  use Patch_module
   246) ! 
   247) !  implicit none
   248) !  
   249) !  SNESLineSearch :: line_search
   250) !  Vec :: X
   251) !  Vec :: dX
   252) !  PetscBool :: changed
   253) !  type(realization_subsurface_type) :: realization
   254) !  PetscReal, pointer :: X_p(:)
   255) !  PetscReal, pointer :: dX_p(:)
   256) !  PetscErrorCode :: ierr
   257) !
   258) !  type(grid_type), pointer :: grid
   259) !  type(option_type), pointer :: option
   260) !  type(patch_type), pointer :: patch
   261) !  type(field_type), pointer :: field
   262) !
   263) !  !type(toil_ims_auxvar_type), pointer :: toil_auxvars(:,:)
   264) !  !type(global_auxvar_type), pointer :: global_auxvars(:)  
   265) !
   266) !  PetscInt :: local_id, ghosted_id
   267) !  PetscInt :: offset
   268) !
   269) !  PetscInt :: pressure_index, saturation_index, temperature_index
   270) !
   271) !  PetscReal :: pressure0, pressure1, del_pressure
   272) !  PetscReal :: temperature0, temperature1, del_temperature
   273) !  PetscReal :: saturation0, saturation1, del_saturation
   274) !
   275) !  PetscReal :: max_saturation_change = 0.125d0
   276) !  PetscReal :: max_temperature_change = 10.d0
   277) !  PetscReal :: scale, temp_scale, temp_real
   278) !  PetscReal, parameter :: tolerance = 0.99d0
   279) !  PetscReal, parameter :: initial_scale = 1.d0
   280) !  SNES :: snes
   281) !  PetscInt :: newton_iteration
   282) !
   283) !  
   284) !  grid => realization%patch%grid
   285) !  option => realization%option
   286) !  field => realization%field
   287) !  !toil_auxvars => realization%patch%aux%TOil_ims%auxvars
   288) !  !global_auxvars => realization%patch%aux%Global%auxvars
   289) !
   290) !  patch => realization%patch
   291) !
   292) !  call SNESLineSearchGetSNES(line_search,snes,ierr)
   293) !  call SNESGetIterationNumber(snes,newton_iteration,ierr)
   294) !
   295) !  call VecGetArrayF90(dX,dX_p,ierr);CHKERRQ(ierr)
   296) !  call VecGetArrayReadF90(X,X_p,ierr);CHKERRQ(ierr)
   297) !
   298) !  changed = PETSC_TRUE
   299) !
   300) !  scale = initial_scale
   301) !  if (toil_ims_max_it_before_damping > 0 .and. &
   302) !      newton_iteration > toil_ims_max_it_before_damping) then
   303) !    scale = toil_ims_damping_factor
   304) !  endif
   305) !
   306) !#define LIMIT_MAX_PRESSURE_CHANGE
   307) !#define LIMIT_MAX_SATURATION_CHANGE
   308) !!!#define LIMIT_MAX_TEMPERATURE_CHANGE
   309) !!! TRUNCATE_PRESSURE is needed for times when the solve wants
   310) !!! to pull them negative.
   311) !!!#define TRUNCATE_PRESSURE
   312) !
   313) !  ! scaling
   314) !  do local_id = 1, grid%nlmax
   315) !    ghosted_id = grid%nL2G(local_id)
   316) !    offset = (local_id-1)*option%nflowdof
   317) !    temp_scale = 1.d0
   318) !
   319) !    pressure_index = offset + TOIL_IMS_PRESSURE_DOF
   320) !    saturation_index = offset + TOIL_IMS_SATURATION_DOF
   321) !    temperature_index  = offset + TOIL_IMS_ENERGY_DOF
   322) !    dX_p(pressure_index) = dX_p(pressure_index) * &
   323) !                             toil_ims_pressure_scale
   324) !    temp_scale = 1.d0
   325) !    del_pressure = dX_p(pressure_index)
   326) !    pressure0 = X_p(pressure_index)
   327) !    pressure1 = pressure0 - del_pressure
   328) !    del_saturation = dX_p(saturation_index)
   329) !    saturation0 = X_p(saturation_index)
   330) !    saturation1 = saturation0 - del_saturation
   331) !#ifdef LIMIT_MAX_PRESSURE_CHANGE
   332) !    if (dabs(del_pressure) > toil_ims_max_pressure_change) then
   333) !      temp_real = dabs(toil_ims_max_pressure_change/del_pressure)
   334) !      temp_scale = min(temp_scale,temp_real)
   335) !     endif
   336) !#endif
   337) !#ifdef TRUNCATE_PRESSURE
   338) !    if (pressure1 <= 0.d0) then
   339) !      if (dabs(del_pressure) > 1.d-40) then
   340) !        temp_real = tolerance * dabs(pressure0 / del_pressure)
   341) !        temp_scale = min(temp_scale,temp_real)
   342) !      endif
   343) !    endif
   344) !#endif !TRUNCATE_PRESSURE
   345) !
   346) !#ifdef LIMIT_MAX_SATURATION_CHANGE
   347) !    if (dabs(del_saturation) > max_saturation_change) then
   348) !       temp_real = dabs(max_saturation_change/del_saturation)
   349) !       temp_scale = min(temp_scale,temp_real)
   350) !    endif
   351) !#endif !LIMIT_MAX_SATURATION_CHANGE        
   352) !    scale = min(scale,temp_scale) 
   353) !  enddo
   354) !
   355) !  temp_scale = scale
   356) !  call MPI_Allreduce(temp_scale,scale,ONE_INTEGER_MPI, &
   357) !                     MPI_DOUBLE_PRECISION, &
   358) !                     MPI_MIN,option%mycomm,ierr)
   359) !
   360) !  ! it performs an homogenous scaling using the smallest scaling factor
   361) !  ! over all subdomains domains
   362) !  if (scale < 0.9999d0) then
   363) !    dX_p = scale*dX_p
   364) !  endif
   365) !
   366) !  call VecRestoreArrayF90(dX,dX_p,ierr);CHKERRQ(ierr)
   367) !  call VecRestoreArrayReadF90(X,X_p,ierr);CHKERRQ(ierr)
   368) !
   369) !end subroutine TOilImsCheckUpdatePre
   370) 
   371) ! ************************************************************************** !
   372) ! this is now defined in pm_toil_ims 
   373) !subroutine TOilImsCheckUpdatePost(line_search,X0,dX,X1,dX_changed, &
   374) !                                   X1_changed,realization,ierr)
   375) !  ! 
   376) !  ! Checks update after to update
   377) !  ! 
   378) !  ! Author: Paolo Orsini
   379) !  ! Date: 11/07/15
   380) !  ! 
   381) !
   382) !  use Realization_Subsurface_class
   383) !  use Grid_module
   384) !  use Field_module
   385) !  use Patch_module
   386) !  use Option_module
   387) !  use Material_Aux_class
   388) ! 
   389) !  implicit none
   390) !  
   391) !  SNESLineSearch :: line_search
   392) !  Vec :: X0
   393) !  Vec :: dX
   394) !  Vec :: X1
   395) !  type(realization_subsurface_type) :: realization
   396) !  ! ignore changed flag for now.
   397) !  PetscBool :: dX_changed
   398) !  PetscBool :: X1_changed
   399) !  
   400) !  PetscReal, pointer :: X0_p(:)
   401) !  PetscReal, pointer :: X1_p(:)
   402) !  PetscReal, pointer :: dX_p(:)
   403) !  PetscReal, pointer :: r_p(:)
   404) !  PetscReal, pointer :: accum_p(:), accum_p2(:)
   405) !  type(grid_type), pointer :: grid
   406) !  type(option_type), pointer :: option
   407) !  type(field_type), pointer :: field
   408) !  type(patch_type), pointer :: patch
   409) !  class(material_auxvar_type), pointer :: material_auxvars(:)  
   410) !  PetscInt :: local_id, ghosted_id
   411) !  PetscInt :: offset , ival, idof
   412) !  PetscReal :: dX_X0, R_A, R
   413) !
   414) !  PetscReal :: inf_norm_rel_update(3), global_inf_norm_rel_update(3)
   415) !  PetscReal :: inf_norm_scaled_residual(3), global_inf_norm_scaled_residual(3)
   416) !  PetscReal :: inf_norm_update(3), global_inf_norm_update(3)
   417) !  PetscReal :: inf_norm_residual(3), global_inf_norm_residual(3)
   418) !  PetscReal :: two_norm_residual(3), global_two_norm_residual(3)
   419) !  PetscReal, parameter :: inf_pres_tol = 1.d-1
   420) !  PetscReal, parameter :: inf_temp_tol = 1.d-5
   421) !  PetscReal, parameter :: inf_sat_tol = 1.d-6
   422) !  !geh: note the scaling by 0.d0 several lines down which prevent false 
   423) !  !     convergence 
   424) !  ! PO scaling by 0 kill the inf_norm_update convergence criteria
   425) !  PetscReal, parameter :: inf_norm_update_tol(3) = &
   426) !    reshape([inf_pres_tol,inf_sat_tol,inf_temp_tol], &
   427) !            shape(inf_norm_update_tol)) * &
   428) !            0.d0
   429) !  PetscReal :: temp(12), global_temp(12)
   430) !  PetscMPIInt :: mpi_int
   431) !  PetscBool :: converged_abs_update
   432) !  PetscBool :: converged_rel_update
   433) !  PetscBool :: converged_scaled_residual
   434) !  PetscReal :: t_over_v
   435) !  PetscErrorCode :: ierr
   436) ! 
   437) !  grid => realization%patch%grid 
   438) !  option => realization%option
   439) !  field => realization%field
   440) !  patch => realization%patch ! in patch imat for active/inactive cells
   441) !  material_auxvars => patch%aux%Material%auxvars 
   442) ! 
   443) !  ! it indicates that neither dX of the updated solution are modified 
   444) !  dX_changed = PETSC_FALSE
   445) !  X1_changed = PETSC_FALSE
   446) !  
   447) !  option%converged = PETSC_FALSE
   448) !  if (option%flow%check_post_convergence) then
   449) !    call VecGetArrayReadF90(dX,dX_p,ierr);CHKERRQ(ierr)
   450) !    call VecGetArrayReadF90(X0,X0_p,ierr);CHKERRQ(ierr)
   451) !    call VecGetArrayReadF90(field%flow_r,r_p,ierr);CHKERRQ(ierr)
   452) !    call VecGetArrayReadF90(field%flow_accum,accum_p,ierr);CHKERRQ(ierr)
   453) !    call VecGetArrayReadF90(field%flow_accum2,accum_p2,ierr);CHKERRQ(ierr)
   454) !
   455) !    inf_norm_update(:) = -1.d20
   456) !    inf_norm_rel_update(:) = -1.d20
   457) !    inf_norm_scaled_residual(:) = -1.d20
   458) !    inf_norm_residual(:) = -1.d20
   459) !    two_norm_residual(:) = 0.d0
   460) !    do local_id = 1, grid%nlmax
   461) !      offset = (local_id-1)*option%nflowdof
   462) !      ghosted_id = grid%nL2G(local_id)
   463) !      if (realization%patch%imat(ghosted_id) <= 0) cycle
   464) !      do idof = 1, option%nflowdof
   465) !        ival = offset+idof
   466) !        R = r_p(ival)
   467) !        inf_norm_residual(idof) = max(inf_norm_residual(idof),dabs(R))
   468) !        if (toil_ims_tough2_conv_criteria) then
   469) !          !geh: scale by t_over_v to match TOUGH2 residual units. see equation
   470) !          !     B.5 of TOUGH2 user manual (LBNL-43134)
   471) !          t_over_v = option%flow_dt/material_auxvars(ghosted_id)%volume
   472) !          if (accum_p2(ival)*t_over_v < toil_ims_tgh2_itol_scld_res_e2) then
   473) !            R_A = dabs(R*t_over_v)
   474) !          else
   475) !            R_A = dabs(R/accum_p2(ival))
   476) !          endif
   477) !        else
   478) !          R_A = dabs(R/accum_p(ival))
   479) !        endif
   480) !        dX_X0 = dabs(dX_p(ival)/X0_p(ival))
   481) !        inf_norm_update(idof) = max(inf_norm_update(idof),dabs(dX_p(ival)))
   482) !        if (inf_norm_rel_update(idof) < dX_X0) then
   483) !          inf_norm_rel_update(idof) = dX_X0
   484) !        endif
   485) !        if (inf_norm_scaled_residual(idof) < R_A) then
   486) !          inf_norm_scaled_residual(idof) = R_A
   487) !        endif
   488) !      enddo
   489) !    enddo
   490) !    temp(1:3) = inf_norm_update(:)
   491) !    temp(4:6) = inf_norm_rel_update(:)
   492) !    temp(7:9) = inf_norm_scaled_residual(:)
   493) !    temp(10:12) = inf_norm_residual(:)
   494) !    mpi_int = 12
   495) !    call MPI_Allreduce(temp,global_temp,mpi_int, &
   496) !                       MPI_DOUBLE_PRECISION,MPI_MAX,option%mycomm,ierr)
   497) !    global_inf_norm_update(:) = global_temp(1:3)
   498) !    global_inf_norm_rel_update(:) = global_temp(4:6)
   499) !    global_inf_norm_scaled_residual(:) = global_temp(7:9)
   500) !    global_inf_norm_residual(:) = global_temp(10:12)
   501) !
   502) !    converged_abs_update = PETSC_TRUE
   503) !    do idof = 1, option%nflowdof
   504) !      ! imposing inf_norm_update <= inf_norm_update_tol for convergence
   505) !      if (global_inf_norm_update(idof) > inf_norm_update_tol(idof)) then
   506) !        converged_abs_update = PETSC_FALSE
   507) !      endif
   508) !    enddo  
   509) !    converged_rel_update = maxval(global_inf_norm_rel_update) < &
   510) !                           option%flow%inf_rel_update_tol
   511) !    if (toil_ims_tough2_conv_criteria) then
   512) !      converged_scaled_residual = maxval(global_inf_norm_scaled_residual) < &
   513) !                                  toil_ims_tgh2_itol_scld_res_e1
   514) !    else
   515) !      converged_scaled_residual = maxval(global_inf_norm_scaled_residual) < &
   516) !                                  option%flow%inf_scaled_res_tol
   517) !    endif
   518) !    option%converged = PETSC_FALSE
   519) !    if (converged_abs_update .or. converged_rel_update .or. &
   520) !        converged_scaled_residual) then
   521) !      option%converged = PETSC_TRUE
   522) !    endif
   523) !    call VecRestoreArrayReadF90(dX,dX_p,ierr);CHKERRQ(ierr)
   524) !    call VecRestoreArrayReadF90(X0,X0_p,ierr);CHKERRQ(ierr)
   525) !    call VecRestoreArrayReadF90(field%flow_r,r_p,ierr);CHKERRQ(ierr)
   526) !    call VecRestoreArrayReadF90(field%flow_accum,accum_p,ierr);CHKERRQ(ierr)
   527) !    call VecRestoreArrayReadF90(field%flow_accum2,accum_p2,ierr);CHKERRQ(ierr)
   528) !  endif
   529) !
   530) !end subroutine TOilImsCheckUpdatePost
   531) 
   532) ! ************************************************************************** !
   533) 
   534) subroutine TOilImsSetPlotVariables(list)
   535)   ! 
   536)   ! Adds variables to be printed to list
   537)   ! 
   538)   ! Author: Paolo Orsini (OGS)
   539)   ! Date: 10/20/15
   540)   ! 
   541)   
   542)   use Output_Aux_module
   543)   use Variables_module
   544)     
   545)   implicit none
   546)   
   547)   type(output_variable_list_type), pointer :: list
   548)   
   549)   character(len=MAXWORDLENGTH) :: name, units
   550)   type(output_variable_type), pointer :: output_variable
   551) 
   552)   if (associated(list%first)) then
   553)     return
   554)   endif
   555)   
   556)   name = 'Temperature'
   557)   units = 'C'
   558)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
   559)                                TEMPERATURE)
   560) 
   561)   name = 'Liquid Pressure'
   562)   units = 'Pa'
   563)   call OutputVariableAddToList(list,name,OUTPUT_PRESSURE,units, &
   564)                                LIQUID_PRESSURE)
   565) 
   566)   name = 'Oil Pressure'
   567)   units = 'Pa'
   568)   call OutputVariableAddToList(list,name,OUTPUT_PRESSURE,units, &
   569)                                OIL_PRESSURE)
   570) 
   571)   name = 'Liquid Saturation'
   572)   units = ''
   573)   call OutputVariableAddToList(list,name,OUTPUT_SATURATION,units, &
   574)                                LIQUID_SATURATION)
   575)   
   576)   name = 'Oil Saturation'
   577)   units = ''
   578)   call OutputVariableAddToList(list,name,OUTPUT_SATURATION,units, &
   579)                                OIL_SATURATION)
   580)   
   581)   name = 'Liquid Density'
   582)   units = 'kg/m^3'
   583)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
   584)                                LIQUID_DENSITY)
   585)   
   586)   name = 'Oil Density'
   587)   units = 'kg/m^3'
   588)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
   589)                                OIL_DENSITY)
   590)   
   591)   name = 'Liquid Energy'
   592)   units = 'MJ/kmol'
   593)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
   594)                                LIQUID_ENERGY)
   595)   
   596)   name = 'Oil Energy'
   597)   units = 'MJ/kmol'
   598)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
   599)                                OIL_ENERGY)
   600)   
   601)  !name = 'Thermodynamic State'
   602)  ! units = ''
   603)  ! output_variable => OutputVariableCreate(name,OUTPUT_DISCRETE,units,STATE)
   604)  ! output_variable%plot_only = PETSC_TRUE ! toggle output off for observation
   605)  ! output_variable%iformat = 1 ! integer
   606)  ! call OutputVariableAddToList(list,output_variable)   
   607)   
   608) end subroutine TOilImsSetPlotVariables
   609) 
   610) ! ************************************************************************** !
   611) 
   612) subroutine TOilImsTimeCut(realization)
   613)   ! 
   614)   ! Resets arrays for time step cut
   615)   ! 
   616)   ! Author: Paolo Orsini
   617)   ! Date: 11/09/15
   618)   ! 
   619)   use Realization_Subsurface_class
   620)   !use Option_module
   621)   !use Field_module
   622)   !use Patch_module
   623)   !use Discretization_module
   624)   !use Grid_module
   625)  
   626)   implicit none
   627)   
   628)   type(realization_subsurface_type) :: realization
   629) 
   630)   !type(option_type), pointer :: option
   631)   !type(patch_type), pointer :: patch
   632)   !type(grid_type), pointer :: grid
   633)   !type(global_auxvar_type), pointer :: global_auxvars(:)  
   634)   !type(general_auxvar_type), pointer :: gen_auxvars(:,:)
   635)   
   636)   !PetscInt :: local_id, ghosted_id
   637)   !PetscErrorCode :: ierr
   638) 
   639)   !option => realization%option
   640)   !patch => realization%patch
   641)   !grid => patch%grid
   642)   !global_auxvars => patch%aux%Global%auxvars
   643)   !gen_auxvars => patch%aux%General%auxvars
   644) 
   645)   ! restore stored state there is not state in ims modules
   646)   !do ghosted_id = 1, grid%ngmax
   647)   !  global_auxvars(ghosted_id)%istate = &
   648)   !    gen_auxvars(ZERO_INTEGER,ghosted_id)%istate_store(PREV_TS)
   649)   !enddo
   650) 
   651) !#ifdef DEBUG_GENERAL_FILEOUTPUT
   652) !  debug_timestep_cut_count = debug_timestep_cut_count + 1
   653) !#endif 
   654) 
   655)   ! PO
   656)   ! if anything else to do when specific to cutting time step - 
   657)   ! for TOIL IMS - add here
   658) 
   659)   call TOilImsInitializeTimestep(realization)
   660) 
   661) end subroutine TOilImsTimeCut
   662) 
   663) ! ************************************************************************** !
   664) 
   665) 
   666) ! ************************************************************************** !
   667) 
   668) subroutine TOilImsUpdateAuxVars(realization)
   669)   ! 
   670)   ! Updates the auxiliary variables associated with the TOilIms problem
   671)   ! 
   672)   ! Author: Paolo Orsini
   673)   ! Date: 10/21/15
   674)   ! 
   675) 
   676)   use Realization_Subsurface_class
   677)   use Patch_module
   678)   use Option_module
   679)   use Field_module
   680)   use Grid_module
   681)   use Coupler_module
   682)   use Connection_module
   683)   use Material_module
   684)   use Material_Aux_class
   685)   !use EOS_Water_module 
   686)   !use Saturation_Function_module
   687)   
   688)   implicit none
   689) 
   690)   type(realization_subsurface_type) :: realization
   691)   PetscBool :: update_state
   692)   
   693)   type(option_type), pointer :: option
   694)   type(patch_type), pointer :: patch
   695)   type(grid_type), pointer :: grid
   696)   type(field_type), pointer :: field
   697)   type(coupler_type), pointer :: boundary_condition
   698)   type(connection_set_type), pointer :: cur_connection_set
   699) 
   700)   type(toil_ims_auxvar_type), pointer :: toil_auxvars(:,:), toil_auxvars_bc(:)  
   701) 
   702)   type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)  
   703) 
   704)   class(material_auxvar_type), pointer :: material_auxvars(:)
   705) 
   706)   PetscInt :: ghosted_id, local_id, sum_connection, idof, iconn, natural_id
   707)   PetscInt :: ghosted_start, ghosted_end
   708)   !PetscInt :: iphasebc, iphase
   709)   PetscInt :: offset
   710)   PetscInt :: istate
   711) 
   712)   !PetscReal :: gas_pressure, capillary_pressure, liquid_saturation
   713)   !PetscReal :: saturation_pressure, temperature
   714) 
   715)   PetscInt :: real_index, variable
   716)   PetscReal, pointer :: xx_loc_p(:)
   717)   PetscReal :: xxbc(realization%option%nflowdof)
   718) 
   719)   PetscErrorCode :: ierr
   720)   
   721)   option => realization%option
   722)   patch => realization%patch
   723)   grid => patch%grid
   724)   field => realization%field
   725) 
   726)   toil_auxvars => patch%aux%TOil_ims%auxvars
   727)   toil_auxvars_bc => patch%aux%TOil_ims%auxvars_bc
   728)   global_auxvars => patch%aux%Global%auxvars
   729)   global_auxvars_bc => patch%aux%Global%auxvars_bc
   730)   material_auxvars => patch%aux%Material%auxvars
   731)     
   732)   call VecGetArrayF90(field%flow_xx_loc,xx_loc_p, ierr);CHKERRQ(ierr)
   733) 
   734)   do ghosted_id = 1, grid%ngmax
   735)     if (grid%nG2L(ghosted_id) < 0) cycle ! bypass ghosted corner cells
   736)      
   737)     !Ignore inactive cells with inactive materials
   738)     if (patch%imat(ghosted_id) <= 0) cycle
   739)     ghosted_end = ghosted_id*option%nflowdof
   740)     ghosted_start = ghosted_end - option%nflowdof + 1
   741)     ! TOIL_IMS_UPDATE_FOR_ACCUM indicates call from non-perturbation
   742)     option%iflag = TOIL_IMS_UPDATE_FOR_ACCUM
   743)     natural_id = grid%nG2A(ghosted_id)
   744)     call TOilImsAuxVarCompute(xx_loc_p(ghosted_start:ghosted_end), &
   745)                        toil_auxvars(ZERO_INTEGER,ghosted_id), &
   746)                        global_auxvars(ghosted_id), &
   747)                        material_auxvars(ghosted_id), &
   748)                        patch%characteristic_curves_array( &
   749)                          patch%sat_func_id(ghosted_id))%ptr, &
   750)                        natural_id, &
   751)                        option)
   752) 
   753)   enddo
   754)   
   755)   ! compute auxiliary variables for boundary cells
   756)   boundary_condition => patch%boundary_condition_list%first
   757)   sum_connection = 0    
   758)   do 
   759)     if (.not.associated(boundary_condition)) exit
   760)     cur_connection_set => boundary_condition%connection_set
   761)     do iconn = 1, cur_connection_set%num_connections
   762)       sum_connection = sum_connection + 1
   763)       local_id = cur_connection_set%id_dn(iconn)
   764)       ghosted_id = grid%nL2G(local_id)
   765)       !negate to indicate boundary connection, not actual cell
   766)       natural_id = -grid%nG2A(ghosted_id) 
   767)       offset = (ghosted_id-1)*option%nflowdof
   768)       if (patch%imat(ghosted_id) <= 0) cycle
   769) 
   770)       xxbc(:) = xx_loc_p(offset+1:offset+option%nflowdof)
   771)       !istate = boundary_condition%flow_aux_int_var(GENERAL_STATE_INDEX,iconn)
   772) 
   773)       ! we do this for all BCs; Neumann bcs will be set later
   774)       do idof = 1, option%nflowdof
   775)         real_index = boundary_condition% &
   776)                        flow_aux_mapping(toil_ims_dof_to_primary_vars(idof))
   777)         if (real_index > 0) then
   778)           xxbc(idof) = boundary_condition%flow_aux_real_var(real_index,iconn)
   779)         else
   780)           option%io_buffer = 'Error setting up boundary condition' // &
   781)                              ' in TOilImsUpdateAuxVars'
   782)           call printErrMsg(option)
   783)         endif
   784)       enddo
   785)         
   786)       ! state not required 
   787)       !toil_auxvars_bc(sum_connection)%istate = istate
   788)       ! TOIL_IMS_UPDATE_FOR_BOUNDARY indicates call from non-perturbation
   789)       option%iflag = TOIL_IMS_UPDATE_FOR_BOUNDARY
   790)       call TOilImsAuxVarCompute(xxbc,toil_auxvars_bc(sum_connection), &
   791)                                 global_auxvars_bc(sum_connection), &
   792)                                 material_auxvars(ghosted_id), &
   793)                                 patch%characteristic_curves_array( &
   794)                                   patch%sat_func_id(ghosted_id))%ptr, &
   795)                                 natural_id, &
   796)                                 option)
   797)     enddo
   798)     boundary_condition => boundary_condition%next
   799)   enddo
   800) 
   801)   call VecRestoreArrayF90(field%flow_xx_loc,xx_loc_p, ierr);CHKERRQ(ierr)
   802) 
   803)   patch%aux%TOil_ims%auxvars_up_to_date = PETSC_TRUE
   804) 
   805) end subroutine TOilImsUpdateAuxVars
   806) 
   807) ! ************************************************************************** !
   808) 
   809) subroutine TOilImsUpdateFixedAccum(realization)
   810)   ! 
   811)   ! Updates the fixed portion of the
   812)   ! accumulation term
   813)   ! 
   814)   ! Author: Paolo Orsini
   815)   ! Date: 10/23/15
   816)   ! 
   817) 
   818)   use Realization_Subsurface_class
   819)   use Patch_module
   820)   use Option_module
   821)   use Field_module
   822)   use Grid_module
   823)   use Material_Aux_class
   824) 
   825)   implicit none
   826)   
   827)   type(realization_subsurface_type) :: realization
   828)   
   829)   type(option_type), pointer :: option
   830)   type(patch_type), pointer :: patch
   831)   type(grid_type), pointer :: grid
   832)   type(field_type), pointer :: field
   833)   type(toil_ims_auxvar_type), pointer :: toil_auxvars(:,:)
   834) 
   835)   type(global_auxvar_type), pointer :: global_auxvars(:)
   836) 
   837)   class(material_auxvar_type), pointer :: material_auxvars(:)
   838)   type(material_parameter_type), pointer :: material_parameter
   839) 
   840)   PetscInt :: ghosted_id, local_id, local_start, local_end
   841)   PetscInt :: imat
   842)   PetscReal, pointer :: xx_p(:), iphase_loc_p(:)
   843)   PetscReal, pointer :: accum_p(:), accum_p2(:)
   844)                           
   845)   PetscErrorCode :: ierr
   846)   
   847)   option => realization%option
   848)   field => realization%field
   849)   patch => realization%patch
   850)   grid => patch%grid
   851) 
   852)   toil_auxvars => patch%aux%TOil_ims%auxvars
   853) 
   854)   global_auxvars => patch%aux%Global%auxvars
   855) 
   856)   material_auxvars => patch%aux%Material%auxvars
   857)   material_parameter => patch%aux%Material%material_parameter
   858)     
   859)   call VecGetArrayReadF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
   860) 
   861)   call VecGetArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
   862) 
   863)   !Tough2 conv. creteria: initialize accumulation term for every iteration
   864)   if (toil_ims_tough2_conv_criteria) then
   865)     call VecGetArrayF90(field%flow_accum2, accum_p2, ierr);CHKERRQ(ierr)
   866)   endif
   867)   
   868)   do local_id = 1, grid%nlmax
   869)     ghosted_id = grid%nL2G(local_id)
   870)     !geh - Ignore inactive cells with inactive materials
   871)     imat = patch%imat(ghosted_id)
   872)     if (imat <= 0) cycle
   873)     local_end = local_id*option%nflowdof
   874)     local_start = local_end - option%nflowdof + 1
   875)     ! TOIL_IMS_UPDATE_FOR_FIXED_ACCUM indicates call from non-perturbation
   876)     option%iflag = TOIL_IMS_UPDATE_FOR_FIXED_ACCUM ! not currently used
   877)     call TOilImsAuxVarCompute(xx_p(local_start:local_end), &
   878)                               toil_auxvars(ZERO_INTEGER,ghosted_id), &
   879)                               global_auxvars(ghosted_id), &
   880)                               material_auxvars(ghosted_id), &
   881)                               patch%characteristic_curves_array( &
   882)                                 patch%sat_func_id(ghosted_id))%ptr, &
   883)                               ghosted_id, &
   884)                               option)
   885)     call TOilImsAccumulation(toil_auxvars(ZERO_INTEGER,ghosted_id), &
   886)                              material_auxvars(ghosted_id), &
   887)                              material_parameter%soil_heat_capacity(imat), &
   888)                              option,accum_p(local_start:local_end) )
   889)   enddo
   890)   
   891)   !Tough2 conv. creteria: initialize accumulation term for every iteration
   892)   if (toil_ims_tough2_conv_criteria) then
   893)     accum_p2 = accum_p
   894)   endif
   895)   
   896)   call VecRestoreArrayReadF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
   897) 
   898)   call VecRestoreArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
   899)   
   900)   !Tough2 conv. creteria: initialize accumulation term for every iteration
   901)   if (toil_ims_tough2_conv_criteria) then
   902)     call VecRestoreArrayF90(field%flow_accum2, accum_p2, ierr);CHKERRQ(ierr)
   903)   endif
   904)   
   905) end subroutine TOilImsUpdateFixedAccum
   906) 
   907) ! ************************************************************************** !
   908) 
   909) subroutine TOilImsUpdateSolution(realization)
   910)   ! 
   911)   ! Updates data in module after a successful time
   912)   ! step: currently it updates only mass balance
   913)   ! 
   914)   ! Author: Paolo Orsini
   915)   ! Date: 10/23/15
   916)   ! 
   917) 
   918)   use Realization_Subsurface_class
   919)   !use Field_module
   920)   !use Patch_module
   921)   !use Discretization_module
   922)   !use Option_module
   923)   !use Grid_module
   924)   
   925)   implicit none
   926)   
   927)   type(realization_subsurface_type) :: realization
   928) 
   929)   !type(option_type), pointer :: option
   930)   !type(patch_type), pointer :: patch
   931)   !type(grid_type), pointer :: grid
   932)   !type(field_type), pointer :: field
   933)   !type(toil_ims_auxvar_type), pointer :: toil_auxvars(:,:)
   934)   !type(global_auxvar_type), pointer :: global_auxvars(:)  
   935)   !PetscInt :: local_id, ghosted_id
   936)   !PetscErrorCode :: ierr
   937)   
   938)   !option => realization%option
   939)   !field => realization%field
   940)   !patch => realization%patch
   941)   !grid => patch%grid
   942)   !gen_auxvars => patch%aux%General%auxvars  
   943)   !global_auxvars => patch%aux%Global%auxvars
   944)   
   945)   if (realization%option%compute_mass_balance_new) then
   946)     call TOilImsUpdateMassBalance(realization)
   947)   endif
   948)   
   949)   
   950)   
   951) end subroutine TOilImsUpdateSolution
   952) 
   953) ! ************************************************************************** !
   954) 
   955) subroutine TOilImsComputeMassBalance(realization,mass_balance)
   956)   ! 
   957)   ! Initializes mass balance
   958)   ! 
   959)   ! Author: Paolo Orsini
   960)   ! Date: 11/12/15
   961)   ! 
   962)  
   963)   use Realization_Subsurface_class
   964)   use Option_module
   965)   use Patch_module
   966)   use Field_module
   967)   use Grid_module
   968)   use Material_Aux_class
   969)  
   970)   implicit none
   971)   
   972)   type(realization_subsurface_type) :: realization
   973)   PetscReal :: mass_balance(realization%option%nflowspec, &
   974)                             realization%option%nphase)
   975) 
   976)   type(option_type), pointer :: option
   977)   type(patch_type), pointer :: patch
   978)   type(field_type), pointer :: field
   979)   type(grid_type), pointer :: grid
   980)   type(toil_ims_auxvar_type), pointer :: toil_auxvars(:,:)
   981)   class(material_auxvar_type), pointer :: material_auxvars(:)
   982) 
   983)   PetscErrorCode :: ierr
   984)   PetscInt :: local_id
   985)   PetscInt :: ghosted_id
   986)   PetscInt :: iphase !, icomp
   987)   PetscReal :: vol_phase
   988) 
   989)   option => realization%option
   990)   patch => realization%patch
   991)   grid => patch%grid
   992)   field => realization%field
   993) 
   994)   toil_auxvars => patch%aux%TOil_ims%auxvars
   995)   material_auxvars => patch%aux%Material%auxvars
   996) 
   997)   mass_balance = 0.d0
   998)   ! note ::  only first column of mass_balance(1:2,1) is used
   999) 
  1000)   do local_id = 1, grid%nlmax
  1001)     ghosted_id = grid%nL2G(local_id)
  1002)     !geh - Ignore inactive cells with inactive materials
  1003)     if (patch%imat(ghosted_id) <= 0) cycle
  1004)     do iphase = 1, option%nphase
  1005)       ! volume_phase = saturation*porosity*volume
  1006)       vol_phase = &
  1007)         toil_auxvars(ZERO_INTEGER,ghosted_id)%sat(iphase)* &
  1008)         toil_auxvars(ZERO_INTEGER,ghosted_id)%effective_porosity* &
  1009)         material_auxvars(ghosted_id)%volume
  1010)       ! mass = volume_phase*density
  1011) 
  1012)         mass_balance(iphase,1) = mass_balance(iphase,1) + &
  1013)           toil_auxvars(ZERO_INTEGER,ghosted_id)%den(iphase)* &
  1014)           toil_ims_fmw_comp(iphase)*vol_phase
  1015) 
  1016)     enddo
  1017)   enddo
  1018) 
  1019) end subroutine TOilImsComputeMassBalance
  1020) 
  1021) ! ************************************************************************** !
  1022) 
  1023) subroutine TOilImsUpdateMassBalance(realization)
  1024)   ! 
  1025)   ! Updates mass balance
  1026)   ! Using existing data structure for two phase compositional
  1027)   ! For memory efficiency define new data structure 
  1028)   ! 
  1029)   ! Author: Paolo Orsini
  1030)   ! Date: 10/23/15
  1031)   ! 
  1032)  
  1033)   use Realization_Subsurface_class
  1034)   use Option_module
  1035)   use Patch_module
  1036)   use Grid_module
  1037)   use EOS_Oil_module
  1038)  
  1039)   implicit none
  1040)   
  1041)   type(realization_subsurface_type) :: realization
  1042) 
  1043)   type(option_type), pointer :: option
  1044)   type(patch_type), pointer :: patch
  1045)   type(global_auxvar_type), pointer :: global_auxvars_bc(:)
  1046)   type(global_auxvar_type), pointer :: global_auxvars_ss(:)
  1047)   
  1048)   PetscInt :: iconn
  1049)   PetscInt :: icomp
  1050) 
  1051)   option => realization%option
  1052)   patch => realization%patch
  1053) 
  1054)   global_auxvars_bc => patch%aux%Global%auxvars_bc
  1055)   global_auxvars_ss => patch%aux%Global%auxvars_ss
  1056) 
  1057)   ! option%nflowspec = 2,
  1058)   ! two species (H2O,OIL): each present only in its own rich phase
  1059) 
  1060)   ! updating with mass balance, assuming molar quantity loaded in:
  1061)   ! mass_balance and mass_balance_delta
  1062) 
  1063)   !write(*,*) "toil fmw", toil_ims_fmw_comp(1), toil_ims_fmw_comp(2)
  1064) 
  1065)   do iconn = 1, patch%aux%TOil_ims%num_aux_bc
  1066)     do icomp = 1, option%nflowspec
  1067)       global_auxvars_bc(iconn)%mass_balance(icomp,:) = &
  1068)         global_auxvars_bc(iconn)%mass_balance(icomp,:) + &
  1069)         global_auxvars_bc(iconn)%mass_balance_delta(icomp,:)* &
  1070)         toil_ims_fmw_comp(icomp)*option%flow_dt
  1071)     enddo
  1072)   enddo
  1073)   do iconn = 1, patch%aux%TOil_ims%num_aux_ss
  1074)     do icomp = 1, option%nflowspec
  1075)       global_auxvars_ss(iconn)%mass_balance(icomp,:) = &
  1076)         global_auxvars_ss(iconn)%mass_balance(icomp,:) + &
  1077)         global_auxvars_ss(iconn)%mass_balance_delta(icomp,:)* &
  1078)         toil_ims_fmw_comp(icomp)*option%flow_dt
  1079)     enddo
  1080)   enddo
  1081) 
  1082) end subroutine TOilImsUpdateMassBalance
  1083) 
  1084) ! ************************************************************************** !
  1085) 
  1086) subroutine TOilImsZeroMassBalanceDelta(realization)
  1087)   ! 
  1088)   ! Zeros mass balance delta array
  1089)   ! 
  1090)   ! Author: Paolo Orsini
  1091)   ! Date: 10/23/15
  1092)   ! 
  1093)  
  1094)   use Realization_Subsurface_class
  1095)   use Option_module
  1096)   use Patch_module
  1097)   use Grid_module
  1098)  
  1099)   implicit none
  1100)   
  1101)   type(realization_subsurface_type) :: realization
  1102) 
  1103)   type(option_type), pointer :: option
  1104)   type(patch_type), pointer :: patch
  1105)   type(global_auxvar_type), pointer :: global_auxvars_bc(:)
  1106)   type(global_auxvar_type), pointer :: global_auxvars_ss(:)
  1107) 
  1108)   PetscInt :: iconn
  1109) 
  1110)   option => realization%option
  1111)   patch => realization%patch
  1112) 
  1113)   global_auxvars_bc => patch%aux%Global%auxvars_bc
  1114)   global_auxvars_ss => patch%aux%Global%auxvars_ss
  1115) 
  1116)   do iconn = 1, patch%aux%TOil_Ims%num_aux_bc
  1117)     global_auxvars_bc(iconn)%mass_balance_delta = 0.d0
  1118)   enddo
  1119)   do iconn = 1, patch%aux%TOil_Ims%num_aux_ss
  1120)     global_auxvars_ss(iconn)%mass_balance_delta = 0.d0
  1121)   enddo
  1122) 
  1123) end subroutine TOilImsZeroMassBalanceDelta
  1124) 
  1125) ! ************************************************************************** !
  1126) 
  1127) subroutine TOilImsMapBCAuxVarsToGlobal(realization)
  1128)   ! 
  1129)   ! Maps toil_ims BC Auxvars to global auxvars
  1130)   ! 
  1131)   ! Author: Paolo Orsini
  1132)   ! Date: 10/23/15
  1133)   ! 
  1134) 
  1135)   use Realization_Subsurface_class
  1136)   use Option_module
  1137)   use Patch_module
  1138)   use Coupler_module
  1139)   use Connection_module
  1140) 
  1141)   implicit none
  1142) 
  1143)   type(realization_subsurface_type) :: realization
  1144)   
  1145)   type(option_type), pointer :: option
  1146)   type(patch_type), pointer :: patch
  1147)   type(coupler_type), pointer :: boundary_condition
  1148)   type(connection_set_type), pointer :: cur_connection_set
  1149)   type(toil_ims_auxvar_type), pointer :: toil_auxvars_bc(:)  
  1150)   type(global_auxvar_type), pointer :: global_auxvars_bc(:)  
  1151) 
  1152)   PetscInt :: sum_connection, iconn
  1153)   
  1154)   option => realization%option
  1155)   patch => realization%patch
  1156) 
  1157)   !NOTE: this is called only if cpoupling to RT
  1158)   if (option%ntrandof == 0) return ! no need to update
  1159)   
  1160)   toil_auxvars_bc => patch%aux%TOil_ims%auxvars_bc
  1161)   global_auxvars_bc => patch%aux%Global%auxvars_bc
  1162)   
  1163)   boundary_condition => patch%boundary_condition_list%first
  1164)   sum_connection = 0    
  1165)   do 
  1166)     if (.not.associated(boundary_condition)) exit
  1167)     cur_connection_set => boundary_condition%connection_set
  1168)     do iconn = 1, cur_connection_set%num_connections
  1169)       sum_connection = sum_connection + 1
  1170)       global_auxvars_bc(sum_connection)%sat = &
  1171)         toil_auxvars_bc(sum_connection)%sat
  1172)       global_auxvars_bc(sum_connection)%den_kg = &
  1173)         toil_auxvars_bc(sum_connection)%den_kg
  1174)       global_auxvars_bc(sum_connection)%temp = &
  1175)         toil_auxvars_bc(sum_connection)%temp
  1176)     enddo
  1177)     boundary_condition => boundary_condition%next
  1178)   enddo
  1179)   
  1180) end subroutine TOilImsMapBCAuxVarsToGlobal
  1181) 
  1182) ! ************************************************************************** !
  1183) 
  1184) subroutine TOilImsAccumulation(toil_auxvar,material_auxvar, &
  1185)                                soil_heat_capacity,option,Res)
  1186)   ! 
  1187)   ! Computes the non-fixed portion of the accumulation
  1188)   ! term for the residual
  1189)   ! 
  1190)   ! Author: Paolo Orsini
  1191)   ! Date: 10/23/15
  1192)   ! 
  1193) 
  1194)   use Option_module
  1195)   use Material_module
  1196)   use Material_Aux_class
  1197)   
  1198)   implicit none
  1199) 
  1200)   type(toil_ims_auxvar_type) :: toil_auxvar
  1201)   class(material_auxvar_type) :: material_auxvar
  1202)   PetscReal :: soil_heat_capacity
  1203)   type(option_type) :: option
  1204)   PetscReal :: Res(option%nflowdof) 
  1205)   !PetscBool :: debug_cell
  1206)   
  1207)   PetscInt :: iphase, energy_id
  1208)   
  1209)   PetscReal :: porosity
  1210)   PetscReal :: v_over_t
  1211)   
  1212)   energy_id = option%energy_id
  1213)   
  1214)   ! v_over_t[m^3 bulk/sec] = vol[m^3 bulk] / dt[sec]
  1215)   v_over_t = material_auxvar%volume / option%flow_dt
  1216)   ! must use toil_auxvar%effective porosity here as it enables numerical 
  1217)   ! derivatives to be employed 
  1218)   porosity = toil_auxvar%effective_porosity
  1219)   
  1220)   ! flow accumulation term units = kmol/s
  1221)   Res = 0.d0
  1222)   do iphase = 1, option%nphase
  1223)     ! Res[kmol comp/m^3 void] = sat[m^3 phase/m^3 void] * 
  1224)     !                           den[kmol phase/m^3 phase] 
  1225)     ! molar balance formulation (kmol)
  1226)     Res(iphase) = Res(iphase) + toil_auxvar%sat(iphase) * &
  1227)                                 toil_auxvar%den(iphase)  
  1228)   enddo
  1229) 
  1230)   ! scale by porosity * volume / dt
  1231)   ! Res[kmol/sec] = Res[kmol/m^3 void] * por[m^3 void/m^3 bulk] * 
  1232)   !                 vol[m^3 bulk] / dt[sec]
  1233)   Res(1:option%nphase) = Res(1:option%nphase) * &
  1234)                             porosity * v_over_t
  1235) 
  1236)   ! energy accumulation term units = MJ/s
  1237)   do iphase = 1, option%nphase
  1238)     ! Res[MJ/m^3 void] = sat[m^3 phase/m^3 void] *
  1239)     !                    den[kmol phase/m^3 phase] * U[MJ/kmol phase]
  1240)     Res(energy_id) = Res(energy_id) + toil_auxvar%sat(iphase) * &
  1241)                                       toil_auxvar%den(iphase) * &
  1242)                                       toil_auxvar%U(iphase)
  1243)   enddo
  1244)   ! Res[MJ/sec] = (Res[MJ/m^3 void] * por[m^3 void/m^3 bulk] + 
  1245)   !                (1-por)[m^3 rock/m^3 bulk] * 
  1246)   !                  dencpr[kg rock/m^3 rock * MJ/kg rock-K] * T[C]) &
  1247)   !               vol[m^3 bulk] / dt[sec]
  1248)   Res(energy_id) = (Res(energy_id) * porosity + &
  1249)                     (1.d0 - porosity) * &
  1250)                     material_auxvar%soil_particle_density * &
  1251)                     soil_heat_capacity * toil_auxvar%temp) * v_over_t
  1252)                     
  1253) end subroutine TOilImsAccumulation
  1254) 
  1255) ! ************************************************************************** !
  1256) 
  1257) ! ************************************************************************** !
  1258) 
  1259) subroutine TOilImsFlux(toil_auxvar_up,global_auxvar_up, &
  1260)                        material_auxvar_up, &
  1261)                        sir_up, &
  1262)                        thermal_conductivity_up, &
  1263)                        toil_auxvar_dn,global_auxvar_dn, &
  1264)                        material_auxvar_dn, &
  1265)                        sir_dn, &
  1266)                        thermal_conductivity_dn, &
  1267)                        area, dist, parameter, &
  1268)                        option,v_darcy,Res)
  1269)   ! 
  1270)   ! Computes the internal flux terms for the residual
  1271)   ! 
  1272)   ! Author: Paolo Orsini
  1273)   ! Date: 10/27/15
  1274)   ! 
  1275)   use Option_module
  1276)   use Material_Aux_class
  1277)   use Connection_module
  1278)  
  1279)   ! no fractures considered for now
  1280)   ! use Fracture_module
  1281)   !use Klinkenberg_module
  1282)   
  1283)   implicit none
  1284)   
  1285)   type(toil_ims_auxvar_type) :: toil_auxvar_up, toil_auxvar_dn
  1286)   type(global_auxvar_type) :: global_auxvar_up, global_auxvar_dn
  1287)   class(material_auxvar_type) :: material_auxvar_up, material_auxvar_dn
  1288)   type(option_type) :: option
  1289)   PetscReal :: sir_up(:), sir_dn(:)
  1290)   PetscReal :: v_darcy(option%nphase)
  1291)   PetscReal :: area
  1292)   PetscReal :: dist(-1:3)
  1293)   type(toil_ims_parameter_type) :: parameter
  1294)   PetscReal :: thermal_conductivity_dn(2)
  1295)   PetscReal :: thermal_conductivity_up(2)
  1296)   PetscReal :: Res(option%nflowdof)
  1297)   !PetscBool :: debug_connection
  1298) 
  1299)   PetscReal :: dist_gravity  ! distance along gravity vector
  1300)   PetscReal :: dist_up, dist_dn
  1301)   PetscReal :: upweight
  1302) 
  1303)   PetscInt :: energy_id
  1304)   PetscInt :: iphase
  1305)  
  1306)   PetscReal :: density_ave, density_kg_ave
  1307)   PetscReal :: uH
  1308)   PetscReal :: H_ave
  1309)   PetscReal :: perm_ave_over_dist(option%nphase)
  1310)   PetscReal :: perm_up, perm_dn           ! no mole fractions
  1311)   PetscReal :: delta_pressure, delta_temp !, delta_xmol,
  1312) 
  1313)   PetscReal :: pressure_ave
  1314)   PetscReal :: gravity_term
  1315)   PetscReal :: mobility, mole_flux, q
  1316)   PetscReal :: stpd_up, stpd_dn
  1317)   PetscReal :: sat_up, sat_dn, den_up, den_dn
  1318)   PetscReal :: temp_ave, stpd_ave_over_dist, tempreal
  1319)   PetscReal :: k_eff_up, k_eff_dn, k_eff_ave, heat_flux
  1320) 
  1321)   ! no diff fluxes - arrays used for debugging only
  1322)   PetscReal :: adv_flux(3,2), diff_flux(2,2)
  1323)   PetscReal :: debug_flux(3,3), debug_dphi(2)
  1324)   
  1325)   PetscReal :: dummy_perm_up, dummy_perm_dn
  1326) 
  1327)   energy_id = option%energy_id
  1328) 
  1329)   call ConnectionCalculateDistances(dist,option%gravity,dist_up,dist_dn, &
  1330)                                     dist_gravity,upweight)
  1331)   call material_auxvar_up%PermeabilityTensorToScalar(dist,perm_up)
  1332)   call material_auxvar_dn%PermeabilityTensorToScalar(dist,perm_dn)
  1333)   
  1334)   ! Fracture permeability change only available for structured grid (Heeho)
  1335)   ! PO nu fractures considered for now
  1336)   !if (associated(material_auxvar_up%fracture)) then
  1337)   !  call FracturePermEvaluate(material_auxvar_up,perm_up,perm_up, &
  1338)   !                            dummy_perm_up,dist)
  1339)   !endif
  1340)   !if (associated(material_auxvar_dn%fracture)) then
  1341)   !  call FracturePermEvaluate(material_auxvar_dn,perm_dn,perm_dn, &
  1342)   !                            dummy_perm_dn,dist)
  1343)   !endif
  1344)   
  1345)   !if (associated(klinkenberg)) then
  1346)   !  perm_ave_over_dist(1) = (perm_up * perm_dn) / &
  1347)   !                          (dist_up*perm_dn + dist_dn*perm_up)
  1348)   !  dummy_perm_up = klinkenberg%Evaluate(perm_up, &
  1349)   !                                       gen_auxvar_up%pres(option%gas_phase))
  1350)   !  dummy_perm_dn = klinkenberg%Evaluate(perm_dn, &
  1351)   !                                       gen_auxvar_dn%pres(option%gas_phase))
  1352)   !  perm_ave_over_dist(2) = (dummy_perm_up * dummy_perm_dn) / &
  1353)   !                          (dist_up*dummy_perm_dn + dist_dn*dummy_perm_up)
  1354)   !else
  1355)     perm_ave_over_dist(:) = (perm_up * perm_dn) / &
  1356)                             (dist_up*perm_dn + dist_dn*perm_up)
  1357)   !endif
  1358)       
  1359)   Res = 0.d0
  1360)   
  1361)   v_darcy = 0.d0
  1362) 
  1363) !#ifdef DEBUG_FLUXES  
  1364) !  adv_flux = 0.d0
  1365) !  diff_flux = 0.d0
  1366) !#endif
  1367) !#ifdef DEBUG_GENERAL_FILEOUTPUT
  1368) !  debug_flux = 0.d0
  1369) !  debug_dphi = 0.d0
  1370) !#endif
  1371) 
  1372) #ifdef TOIL_CONVECTION
  1373)   do iphase = 1, option%nphase
  1374)  
  1375)     if (toil_auxvar_up%mobility(iphase) + &
  1376)         toil_auxvar_dn%mobility(iphase) < eps) then
  1377)       cycle
  1378)     endif
  1379) 
  1380)     ! an alternative could be to avergae using oil_sat
  1381)     !density_kg_ave = 0.5d0* ( toil_auxvar_up%den_kg(iphase) + &
  1382)     !                          toil_auxvar_dn%den_kg(iphase) )
  1383)     density_kg_ave = TOilImsAverageDensity(toil_auxvar_up%sat(iphase), &
  1384)                      toil_auxvar_dn%sat(iphase), &
  1385)                      toil_auxvar_up%den_kg(iphase), &
  1386)                      toil_auxvar_dn%den_kg(iphase))
  1387) 
  1388)     gravity_term = density_kg_ave * dist_gravity
  1389)     delta_pressure = toil_auxvar_up%pres(iphase) - &
  1390)                      toil_auxvar_dn%pres(iphase) + &
  1391)                      gravity_term
  1392) 
  1393) !#ifdef DEBUG_GENERAL_FILEOUTPUT
  1394) !      debug_dphi(iphase) = delta_pressure
  1395) !#endif
  1396) 
  1397)     ! upwinding the mobilities and enthalpies
  1398)     if (delta_pressure >= 0.D0) then
  1399)       mobility = toil_auxvar_up%mobility(iphase)
  1400)       H_ave = toil_auxvar_up%H(iphase)
  1401)       uH = H_ave
  1402)       !density_ave = toil_auxvar_up%den(iphase)
  1403)     else
  1404)       mobility = toil_auxvar_dn%mobility(iphase)
  1405)       H_ave = toil_auxvar_dn%H(iphase)
  1406)       uH = H_ave
  1407)       !density_ave = toil_auxvar_dn%den(iphase)
  1408)     endif      
  1409) 
  1410)     if (mobility > floweps) then
  1411)       ! v_darcy[m/sec] = perm[m^2] / dist[m] * kr[-] / mu[Pa-sec]
  1412)       !                    dP[Pa]]
  1413)       v_darcy(iphase) = perm_ave_over_dist(iphase) * mobility * delta_pressure
  1414) 
  1415)       ! if comments below, use upwinding value
  1416)       !density_ave = 0.5d0*( toil_auxvar_up%den(iphase) + &
  1417)       !                      toil_auxvar_dn%den(iphase))
  1418) 
  1419)       density_ave = TOilImsAverageDensity(toil_auxvar_up%sat(iphase), &
  1420)                            toil_auxvar_dn%sat(iphase), &
  1421)                            toil_auxvar_up%den(iphase), &
  1422)                            toil_auxvar_dn%den(iphase))       
  1423)  
  1424)       ! q[m^3 phase/sec] = v_darcy[m/sec] * area[m^2]
  1425)       q = v_darcy(iphase) * area  
  1426)       ! mole_flux[kmol phase/sec] = q[m^3 phase/sec] * 
  1427)       !                             density_ave[kmol phase/m^3 phase]        
  1428)       mole_flux = q*density_ave
  1429)       ! Res[kmol total/sec]
  1430) 
  1431)       ! Res[kmol phase/sec] = mole_flux[kmol phase/sec]  
  1432)       Res(iphase) = Res(iphase) + mole_flux 
  1433) 
  1434)       !do icomp = 1, option%nflowspec
  1435)       !  ! Res[kmol comp/sec] = mole_flux[kmol phase/sec] * 
  1436)       !  !                      xmol[kmol comp/kmol phase]
  1437)       !  Res(icomp) = Res(icomp) + mole_flux * xmol(icomp)
  1438)       !enddo
  1439) 
  1440) !#ifdef DEBUG_FLUXES  
  1441) !      do icomp = 1, option%nflowspec
  1442) !        adv_flux(icomp) = adv_flux(icomp) + mole_flux * xmol(icomp)
  1443) !      enddo      ! Res[MJ/sec] = mole_flux[kmol comp/sec] * H_ave[MJ/kmol comp]
  1444) !#endif
  1445) !#ifdef DEBUG_GENERAL_FILEOUTPUT
  1446) !      do icomp = 1, option%nflowspec
  1447) !        debug_flux(icomp,iphase) = debug_flux(icomp,iphase) + mole_flux * xmol(icomp)
  1448) !      enddo      ! Res[MJ/sec] = mole_flux[kmol comp/sec] * H_ave[MJ/kmol comp]
  1449) !#endif
  1450) 
  1451)       Res(energy_id) = Res(energy_id) + mole_flux * uH
  1452) 
  1453) !#ifdef DEBUG_FLUXES  
  1454) !      adv_flux(energy_id) = adv_flux(energy_id) + mole_flux * uH
  1455) !#endif
  1456) !#ifdef DEBUG_GENERAL_FILEOUTPUT
  1457) !      debug_dphi(iphase) = delta_pressure
  1458) !      debug_flux(energy_id,iphase) = debug_flux(energy_id,iphase) + mole_flux * uH
  1459) !#endif
  1460) 
  1461)     endif  ! if mobility larger than given tolerance                 
  1462) 
  1463)   enddo
  1464) #endif 
  1465) ! TOIL_CONVECTION
  1466) 
  1467) !#ifdef DEBUG_GENERAL_FILEOUTPUT
  1468) !  if (debug_flag > 0) then  
  1469) !    write(debug_unit,'(a,7es24.15)') 'delta pressure :', debug_dphi(:)
  1470) !    write(debug_unit,'(a,7es24.15)') 'adv flux (liquid):', debug_flux(:,1)
  1471) !    write(debug_unit,'(a,7es24.15)') 'adv flux (gas):', debug_flux(:,2)
  1472) !  endif
  1473) !  debug_flux = 0.d0
  1474) !#endif                    
  1475) 
  1476) #ifdef TOIL_CONDUCTION
  1477)   ! model for liquid + gas
  1478)   ! add heat conduction flux
  1479)   ! based on Somerton et al., 1974:
  1480)   ! k_eff = k_dry + sqrt(s_l)*(k_sat-k_dry)
  1481)   !k_eff_up = thermal_conductivity_up(1) + &
  1482)   !           sqrt(gen_auxvar_up%sat(option%liquid_phase)) * &
  1483)   !           (thermal_conductivity_up(2) - thermal_conductivity_up(1))
  1484)   !k_eff_dn = thermal_conductivity_dn(1) + &
  1485)   !           sqrt(gen_auxvar_dn%sat(option%liquid_phase)) * &
  1486)   !           (thermal_conductivity_dn(2) - thermal_conductivity_dn(1))
  1487)   !if (k_eff_up > 0.d0 .or. k_eff_up > 0.d0) then
  1488)   !  k_eff_ave = (k_eff_up*k_eff_dn)/(k_eff_up*dist_dn+k_eff_dn*dist_up)
  1489)   !else
  1490)   !  k_eff_ave = 0.d0
  1491)   !endif
  1492)   ! considered the formation fully saturated in water for heat conduction 
  1493)   k_eff_up = thermal_conductivity_up(1)
  1494)   k_eff_dn = thermal_conductivity_dn(1)
  1495)   if (k_eff_up > 0.d0 .or. k_eff_up > 0.d0) then
  1496)     k_eff_ave = (k_eff_up*k_eff_dn)/(k_eff_up*dist_dn+k_eff_dn*dist_up)
  1497)   else
  1498)     k_eff_ave = 0.d0
  1499)   endif
  1500) 
  1501)   ! units:
  1502)   ! k_eff = W/K-m = J/s/K-m
  1503)   ! delta_temp = K
  1504)   ! area = m^2
  1505)   ! heat_flux = k_eff * delta_temp * area = J/s
  1506)   delta_temp = toil_auxvar_up%temp - toil_auxvar_dn%temp
  1507)   heat_flux = k_eff_ave * delta_temp * area * 1.d-6 ! J/s -> MJ/s
  1508)   ! MJ/s
  1509)   Res(energy_id) = Res(energy_id) + heat_flux
  1510) ! CONDUCTION
  1511) #endif
  1512) 
  1513) !#ifdef DEBUG_FLUXES  
  1514) !  if (debug_connection) then  
  1515) !!    write(*,'(a,7es12.4)') 'in: ', adv_flux(:)*dist(1), diff_flux(:)*dist(1)
  1516) !    write(*,'('' phase: gas'')')
  1517) !    write(*,'(''  pressure   :'',2es12.4)') gen_auxvar_up%pres(2), gen_auxvar_dn%pres(2)
  1518) !    write(*,'(''  saturation :'',2es12.4)') gen_auxvar_up%sat(2), gen_auxvar_dn%sat(2)
  1519) !    write(*,'(''  water --'')')
  1520) !    write(*,'(''   darcy flux:'',es12.4)') adv_flux(1,2)
  1521) !    write(*,'(''   xmol      :'',2es12.4)') gen_auxvar_up%xmol(1,2), gen_auxvar_dn%xmol(1,2)
  1522) !    write(*,'(''   diff flux :'',es12.4)') diff_flux(1,2)
  1523) !    write(*,'(''  air --'')')
  1524) !    write(*,'(''   darcy flux:'',es12.4)') adv_flux(2,2)
  1525) !    write(*,'(''   xmol      :'',2es12.4)') gen_auxvar_up%xmol(2,2), gen_auxvar_dn%xmol(2,2)
  1526) !    write(*,'(''   diff flux :'',es12.4)') diff_flux(2,2)
  1527) !    write(*,'(''  heat flux  :'',es12.4)') (adv_flux(3,2) + heat_flux)*1.d6
  1528) !    write(*,'('' phase: liquid'')')
  1529) !    write(*,'(''  pressure   :'',2es12.4)') gen_auxvar_up%pres(1), gen_auxvar_dn%pres(1)
  1530) !    write(*,'(''  saturation :'',2es12.4)') gen_auxvar_up%sat(1), gen_auxvar_dn%sat(1)
  1531) !    write(*,'(''  water --'')')
  1532) !    write(*,'(''   darcy flux:'',es12.4)') adv_flux(1,1)
  1533) !    write(*,'(''   xmol      :'',2es12.4)') gen_auxvar_up%xmol(1,1), gen_auxvar_dn%xmol(1,1)
  1534) !    write(*,'(''   diff flux :'',es12.4)') diff_flux(1,1)
  1535) !    write(*,'(''  air --'')')
  1536) !    write(*,'(''   darcy flux:'',es12.4)') adv_flux(2,1)
  1537) !    write(*,'(''   xmol      :'',2es12.4)') gen_auxvar_up%xmol(2,1), gen_auxvar_dn%xmol(2,1)
  1538) !    write(*,'(''   diff flux :'',es12.4)') diff_flux(2,1)
  1539) !    write(*,'(''  heat flux  :'',es12.4)') (adv_flux(3,1) + heat_flux)*1.d6
  1540) !  endif
  1541) !#endif
  1542) 
  1543) !#ifdef DEBUG_GENERAL_FILEOUTPUT
  1544) !  debug_flux(energy_id,1) = debug_flux(energy_id,1) + heat_flux
  1545) !  if (debug_flag > 0) then  
  1546) !    write(debug_unit,'(a,7es24.15)') 'dif flux (liquid):', debug_flux(:,1)
  1547) !    write(debug_unit,'(a,7es24.15)') 'dif flux (gas):', debug_flux(:,2)
  1548) !  endif
  1549) !#endif
  1550) 
  1551) end subroutine TOilImsFlux
  1552) 
  1553) ! ************************************************************************** !
  1554) 
  1555) subroutine TOilImsBCFlux(ibndtype,auxvar_mapping,auxvars, &
  1556)                          toil_auxvar_up,global_auxvar_up, &
  1557)                          toil_auxvar_dn,global_auxvar_dn, &
  1558)                          material_auxvar_dn, &
  1559)                          sir_dn, &
  1560)                          thermal_conductivity_dn, &
  1561)                          area,dist,toil_parameter, &
  1562)                          option,v_darcy,Res)
  1563)   ! 
  1564)   ! Computes the boundary flux terms for the residual
  1565)   ! 
  1566)   ! Author: Paolo Orsini
  1567)   ! Date: 10/27/15
  1568)   ! 
  1569)   use Option_module                              
  1570)   use Material_Aux_class
  1571)   !use Fracture_module
  1572)   !use Klinkenberg_module
  1573)   
  1574)   implicit none
  1575)   
  1576)   type(toil_ims_auxvar_type) :: toil_auxvar_up, toil_auxvar_dn
  1577)   type(global_auxvar_type) :: global_auxvar_up, global_auxvar_dn
  1578)   class(material_auxvar_type) :: material_auxvar_dn
  1579)   type(option_type) :: option
  1580)   PetscReal :: sir_dn(:)
  1581)   PetscReal :: auxvars(:) ! from aux_real_var array
  1582)   PetscReal :: v_darcy(option%nphase), area
  1583)   type(toil_ims_parameter_type) :: toil_parameter
  1584)   PetscReal :: dist(-1:3)
  1585)   PetscReal :: Res(1:option%nflowdof)
  1586)   PetscInt :: ibndtype(1:option%nflowdof)
  1587)   PetscInt :: auxvar_mapping(TOIL_IMS_MAX_INDEX)
  1588)   PetscReal :: thermal_conductivity_dn(2)
  1589)   !PetscBool :: debug_connection
  1590)   
  1591)   PetscInt :: energy_id
  1592)   PetscInt :: iphase
  1593)   PetscInt :: bc_type
  1594)   PetscReal :: density_ave, density_kg_ave
  1595)   PetscReal :: H_ave, uH
  1596)   PetscReal :: perm_dn_adj(option%nphase)
  1597)   PetscReal :: perm_ave_over_dist
  1598)   PetscReal :: dist_gravity
  1599)   PetscReal :: delta_pressure, delta_temp
  1600)   PetscReal :: gravity_term
  1601)   PetscReal :: mobility, mole_flux, q
  1602)   PetscReal :: sat_dn, perm_dn, den_dn
  1603)   PetscReal :: temp_ave, stpd_ave_over_dist, pres_ave
  1604)   PetscReal :: k_eff_up, k_eff_dn, k_eff_ave, heat_flux
  1605)   ! for debugging only
  1606)   PetscReal :: adv_flux(3,2), diff_flux(2,2)
  1607)   PetscReal :: debug_flux(3,3), debug_dphi(2)
  1608) 
  1609)   PetscReal :: boundary_pressure
  1610)   PetscReal :: tempreal
  1611)   
  1612)   PetscInt :: idof
  1613)   PetscBool :: neumann_bc_present
  1614)   
  1615)   PetscReal :: dummy_perm_dn
  1616)   
  1617)   energy_id = option%energy_id
  1618) 
  1619)   Res = 0.d0
  1620)   v_darcy = 0.d0 
  1621)  
  1622) !#ifdef DEBUG_FLUXES    
  1623) !  adv_flux = 0.d0
  1624) !  diff_flux = 0.d0
  1625) !#endif
  1626) !#ifdef DEBUG_GENERAL_FILEOUTPUT
  1627) !  debug_flux = 0.d0
  1628) !  debug_dphi = 0.d0
  1629) !#endif
  1630) 
  1631)   neumann_bc_present = PETSC_FALSE
  1632)   
  1633)   call material_auxvar_dn%PermeabilityTensorToScalar(dist,perm_dn)
  1634) 
  1635)   ! currently no fractures considered 
  1636)   ! Fracture permeability change only available for structured grid (Heeho)
  1637)   !if (associated(material_auxvar_dn%fracture)) then
  1638)   !  call FracturePermEvaluate(material_auxvar_dn,perm_dn,perm_dn, &
  1639)   !                            dummy_perm_dn,dist)
  1640)   !endif  
  1641)   
  1642)   !if (associated(klinkenberg)) then
  1643)   !  perm_dn_adj(1) = perm_dn
  1644)   !                                        
  1645)   !  perm_dn_adj(2) = klinkenberg%Evaluate(perm_dn, &
  1646)   !                                        gen_auxvar_dn%pres(option%gas_phase))
  1647)   !else
  1648)     perm_dn_adj(:) = perm_dn
  1649)   !endif
  1650)   
  1651) #ifdef TOIL_CONVECTION  
  1652)   do iphase = 1, option%nphase
  1653)  
  1654)     bc_type = ibndtype(iphase) ! loop over equations 1.Liq and 2.Oil
  1655)     select case(bc_type)
  1656)       ! figure out the direction of flow
  1657)       case(DIRICHLET_BC,HYDROSTATIC_BC,SEEPAGE_BC,CONDUCTANCE_BC)
  1658) 
  1659)         ! dist(0) = scalar - magnitude of distance
  1660)         ! gravity = vector(3)
  1661)         ! dist(1:3) = vector(3) - unit vector
  1662)         dist_gravity = dist(0) * dot_product(option%gravity,dist(1:3))
  1663)       
  1664)         if (bc_type == CONDUCTANCE_BC) then !not implemented yet
  1665)           select case(iphase)
  1666)             case(LIQUID_PHASE)
  1667)               idof = auxvar_mapping(TOIL_IMS_LIQ_CONDUCTANCE_INDEX)
  1668)             case(TOIL_IMS_OIL_PHASE)
  1669)               idof = auxvar_mapping(TOIL_IMS_OIL_CONDUCTANCE_INDEX)
  1670)           end select        
  1671)           perm_ave_over_dist = auxvars(idof)
  1672)         else
  1673)           perm_ave_over_dist = perm_dn_adj(iphase) / dist(0)
  1674)         endif
  1675)         
  1676)         ! PO need to check what values of saturations are assigned to the BC ghost cells  
  1677)         ! using residual saturation cannot be correct! - geh
  1678)         ! reusing sir_dn for bounary auxvar
  1679) !#define BAD_MOVE1 ! this works
  1680) !#ifndef BAD_MOVE1       
  1681)         if (toil_auxvar_up%sat(iphase) > sir_dn(iphase) .or. &
  1682)             toil_auxvar_dn%sat(iphase) > sir_dn(iphase)) then
  1683) !#endif
  1684)           boundary_pressure = toil_auxvar_up%pres(iphase)
  1685) 
  1686)           ! PO no free surfce boundaries considered  
  1687)           !if (iphase == LIQUID_PHASE .and. &
  1688)           !    global_auxvar_up%istate == GAS_STATE) then
  1689)           !  ! the idea here is to accommodate a free surface boundary
  1690)           !  ! face.  this will not work for an interior grid cell as
  1691)           !  ! there should be capillary pressure in force.
  1692)           !  boundary_pressure = gen_auxvar_up%pres(option%gas_phase)
  1693)           !endif
  1694) 
  1695)           !density_kg_ave = 0.5d0 * (toil_auxvar_up%den_kg(iphase) + &
  1696)           !                          toil_auxvar_dn%den_kg(iphase) )
  1697) 
  1698)           density_kg_ave = TOilImsAverageDensity(toil_auxvar_up%sat(iphase), &
  1699)                            toil_auxvar_dn%sat(iphase), &
  1700)                            toil_auxvar_up%den_kg(iphase), &
  1701)                            toil_auxvar_dn%den_kg(iphase))
  1702) 
  1703)           gravity_term = density_kg_ave * dist_gravity
  1704)           delta_pressure = boundary_pressure - &
  1705)                            toil_auxvar_dn%pres(iphase) + &
  1706)                            gravity_term
  1707) 
  1708) !#ifdef DEBUG_GENERAL_FILEOUTPUT
  1709) !          debug_dphi(iphase) = delta_pressure
  1710) !#endif
  1711)           ! PO CONDUCTANCE_BC and SEEPAGE_BC not implemented
  1712)           if (bc_type == SEEPAGE_BC .or. &
  1713)               bc_type == CONDUCTANCE_BC) then
  1714)                 ! flow in         ! boundary cell is <= pref
  1715)             if (delta_pressure > 0.d0 .and. &
  1716)                 toil_auxvar_up%pres(iphase) - &
  1717)                  option%reference_pressure < eps) then
  1718)               delta_pressure = 0.d0
  1719)             endif
  1720)           endif
  1721)           
  1722)           !upwinding mobilities and enthalpies   
  1723)           if (delta_pressure >= 0.D0) then
  1724)             mobility = toil_auxvar_up%mobility(iphase)
  1725)             uH = toil_auxvar_up%H(iphase)
  1726)             !density_ave = toil_auxvar_up%den(iphase)
  1727)           else
  1728)             mobility = toil_auxvar_dn%mobility(iphase)
  1729)             uH = toil_auxvar_dn%H(iphase)
  1730)             !density_ave = toil_auxvar_dn%den(iphase)
  1731)           endif      
  1732) 
  1733)           if (mobility > floweps) then
  1734)             ! v_darcy[m/sec] = perm[m^2] / dist[m] * kr[-] / mu[Pa-sec]
  1735)             !                    dP[Pa]]
  1736)             v_darcy(iphase) = perm_ave_over_dist * mobility * delta_pressure
  1737)             ! only need average density if velocity > 0.
  1738) 
  1739)             ! when this is commented - using upwinding value
  1740)             !density_ave = 0.5d0 * (toil_auxvar_up%den(iphase) + &
  1741)             !                       toil_auxvar_dn%den(iphase) )
  1742)             density_ave = TOilImsAverageDensity(toil_auxvar_up%sat(iphase), &
  1743)                            toil_auxvar_dn%sat(iphase), &
  1744)                            toil_auxvar_up%den(iphase), &
  1745)                            toil_auxvar_dn%den(iphase))
  1746)           endif
  1747) !#ifndef BAD_MOVE1        
  1748)         endif ! sat > eps
  1749) !#endif
  1750) 
  1751)       case(NEUMANN_BC)
  1752)         select case(iphase)
  1753)           case(LIQUID_PHASE)
  1754)             idof = auxvar_mapping(TOIL_IMS_LIQUID_FLUX_INDEX)
  1755)           case(TOIL_IMS_OIL_PHASE)
  1756)             idof = auxvar_mapping(TOIL_IMS_OIL_FLUX_INDEX)
  1757)         end select
  1758)         
  1759)         neumann_bc_present = PETSC_TRUE
  1760)         if (dabs(auxvars(idof)) > floweps) then
  1761)           v_darcy(iphase) = auxvars(idof)
  1762)           if (v_darcy(iphase) > 0.d0) then 
  1763)             density_ave = toil_auxvar_up%den(iphase)
  1764)             uH = toil_auxvar_up%H(iphase)
  1765)           else 
  1766)             density_ave = toil_auxvar_dn%den(iphase)
  1767)             uH = toil_auxvar_dn%H(iphase)
  1768)           endif 
  1769)         endif
  1770)       case default
  1771)         option%io_buffer = &
  1772)           'Boundary condition type not recognized in GeneralBCFlux phase loop.'
  1773)         call printErrMsg(option)
  1774)     end select
  1775) 
  1776)     if (dabs(v_darcy(iphase)) > 0.d0) then
  1777)       ! q[m^3 phase/sec] = v_darcy[m/sec] * area[m^2]
  1778)       q = v_darcy(iphase) * area
  1779)       ! mole_flux[kmol phase/sec] = q[m^3 phase/sec] * 
  1780)       !                              density_ave[kmol phase/m^3 phase]
  1781)       mole_flux = q*density_ave       
  1782)   
  1783)       ! Res[kmol total/sec]
  1784)       Res(iphase) = Res(iphase) + mole_flux
  1785)  
  1786)       ! Res[kmol total/sec]
  1787)       !do icomp = 1, option%nflowspec
  1788)       !  ! Res[kmol comp/sec] = mole_flux[kmol phase/sec] * 
  1789)       !  !                      xmol[kmol comp/mol phase]
  1790)       !  Res(icomp) = Res(icomp) + mole_flux * xmol(icomp)
  1791)       !enddo
  1792) !#ifdef DEBUG_FLUXES  
  1793) !      do icomp = 1, option%nflowspec
  1794) !        adv_flux(icomp,iphase) = adv_flux(icomp,iphase) + mole_flux * xmol(icomp)
  1795) !      enddo
  1796) !#endif
  1797) !#ifdef DEBUG_GENERAL_FILEOUTPUT
  1798) !      do icomp = 1, option%nflowspec
  1799) !        debug_flux(icomp,iphase) = debug_flux(icomp,iphase) + mole_flux * xmol(icomp)
  1800) !      enddo
  1801) !#endif
  1802)       ! Res[MJ/sec] = mole_flux[kmol comp/sec] * H_ave[MJ/kmol comp]
  1803)       Res(energy_id) = Res(energy_id) + mole_flux * uH ! H_ave
  1804) !#ifdef DEBUG_FLUXES  
  1805) !      adv_flux(energy_id,iphase) = adv_flux(energy_id,iphase) + mole_flux * uH
  1806) !#endif
  1807) !#ifdef DEBUG_GENERAL_FILEOUTPUT
  1808) !      debug_flux(energy_id,iphase) = debug_flux(energy_id,iphase) + mole_flux * uH
  1809) !#endif
  1810)     endif
  1811)   enddo
  1812) #endif 
  1813) ! end of TOIL_CONVECTION
  1814)   
  1815) !#ifdef DEBUG_GENERAL_FILEOUTPUT
  1816) !  if (debug_flag > 0) then 
  1817) !    write(debug_unit,'(a,7es24.15)') 'bc delta pressure :', debug_dphi(:)  
  1818) !    write(debug_unit,'(a,7es24.15)') 'bc adv flux (liquid):', debug_flux(:,1)
  1819) !    write(debug_unit,'(a,7es24.15)') 'bc adv flux (gas):', debug_flux(:,2)
  1820) !  endif
  1821) !  debug_flux = 0.d0
  1822) !#endif  
  1823) 
  1824) 
  1825) #ifdef TOIL_CONDUCTION
  1826)   ! add heat conduction flux
  1827)   heat_flux = 0.d0
  1828)   select case (ibndtype(TOIL_IMS_ENERGY_EQUATION_INDEX))
  1829)     case (DIRICHLET_BC)
  1830)       ! based on Somerton et al., 1974:
  1831)       ! k_eff = k_dry + sqrt(s_l)*(k_sat-k_dry)
  1832)       !k_eff_dn = thermal_conductivity_dn(1) + &
  1833)       !           sqrt(gen_auxvar_dn%sat(option%liquid_phase)) * &
  1834)       !           (thermal_conductivity_dn(2) - thermal_conductivity_dn(1))
  1835)       ! considered the formation fully saturated in water for heat conduction
  1836)       k_eff_dn = thermal_conductivity_dn(1)
  1837)       ! units:
  1838)       ! k_eff = W/K/m/m = J/s/K/m/m
  1839)       ! delta_temp = K
  1840)       ! area = m^2
  1841)       ! heat_flux = J/s
  1842)       k_eff_ave = k_eff_dn / dist(0)
  1843)       delta_temp = toil_auxvar_up%temp - toil_auxvar_dn%temp
  1844)       heat_flux = k_eff_ave * delta_temp * area * 1.d-6 ! convert W -> MW
  1845)     case(NEUMANN_BC)
  1846)                   ! flux prescribed as MW/m^2
  1847)       heat_flux = auxvars(auxvar_mapping(TOIL_IMS_ENERGY_FLUX_INDEX)) * area
  1848)     case(ZERO_GRADIENT_BC)
  1849)       ! No contribution to heat_flux
  1850)     case default
  1851)       option%io_buffer = 'Boundary condition type not recognized in ' // &
  1852)         'TOilImsBCFlux heat conduction loop.'
  1853)       call printErrMsg(option)
  1854)   end select
  1855)   Res(energy_id) = Res(energy_id) + heat_flux ! MW
  1856) #endif 
  1857) ! end of TOIL_CONDUCTION
  1858) 
  1859) !#ifdef DEBUG_FLUXES  
  1860) !  if (debug_connection) then  
  1861) !!    write(*,'(a,7es12.4)') 'in: ', adv_flux(:)*dist(1), diff_flux(:)*dist(1)
  1862) !    write(*,'('' phase: gas'')')
  1863) !    write(*,'(''  pressure   :'',2es12.4)') gen_auxvar_up%pres(2), gen_auxvar_dn%pres(2)
  1864) !    write(*,'(''  saturation :'',2es12.4)') gen_auxvar_up%sat(2), gen_auxvar_dn%sat(2)
  1865) !    write(*,'(''  water --'')')
  1866) !    write(*,'(''   darcy flux:'',es12.4)') adv_flux(1,2)
  1867) !    write(*,'(''   xmol      :'',2es12.4)') gen_auxvar_up%xmol(1,2), gen_auxvar_dn%xmol(1,2)
  1868) !    write(*,'(''   diff flux :'',es12.4)') diff_flux(1,2)
  1869) !    write(*,'(''  air --'')')
  1870) !    write(*,'(''   darcy flux:'',es12.4)') adv_flux(2,2)
  1871) !    write(*,'(''   xmol      :'',2es12.4)') gen_auxvar_up%xmol(2,2), gen_auxvar_dn%xmol(2,2)
  1872) !    write(*,'(''   diff flux :'',es12.4)') diff_flux(2,2)
  1873) !    write(*,'(''  heat flux  :'',es12.4)') (adv_flux(3,2) + heat_flux)*1.d6
  1874) !    write(*,'('' phase: liquid'')')
  1875) !    write(*,'(''  pressure   :'',2es12.4)') gen_auxvar_up%pres(1), gen_auxvar_dn%pres(1)
  1876) !    write(*,'(''  saturation :'',2es12.4)') gen_auxvar_up%sat(1), gen_auxvar_dn%sat(1)
  1877) !    write(*,'(''  water --'')')
  1878) !    write(*,'(''   darcy flux:'',es12.4)') adv_flux(1,1)
  1879) !    write(*,'(''   xmol      :'',2es12.4)') gen_auxvar_up%xmol(1,1), gen_auxvar_dn%xmol(1,1)
  1880) !    write(*,'(''   diff flux :'',es12.4)') diff_flux(1,1)
  1881) !    write(*,'(''  air --'')')
  1882) !    write(*,'(''   darcy flux:'',es12.4)') adv_flux(2,1)
  1883) !    write(*,'(''   xmol      :'',2es12.4)') gen_auxvar_up%xmol(2,1), gen_auxvar_dn%xmol(2,1)
  1884) !    write(*,'(''   diff flux :'',es12.4)') diff_flux(2,1)
  1885) !    write(*,'(''  heat flux  :'',es12.4)') (adv_flux(3,1) + heat_flux)*1.d6
  1886) !  endif
  1887) !#endif
  1888) 
  1889) !#ifdef DEBUG_GENERAL_FILEOUTPUT
  1890) !  debug_flux(energy_id,1) = debug_flux(energy_id,1) + heat_flux
  1891) !  if (debug_flag > 0) then  
  1892) !    write(debug_unit,'(a,7es24.15)') 'bc dif flux (liquid):', debug_flux(:,1)*dist(3)
  1893) !    write(debug_unit,'(a,7es24.15)') 'bc dif flux (gas):', debug_flux(:,2)*dist(3)
  1894) !  endif
  1895) !#endif
  1896)   
  1897) end subroutine TOilImsBCFlux
  1898) 
  1899) ! ************************************************************************** !
  1900) 
  1901) subroutine TOilImsSrcSink(option,src_sink_condition, toil_auxvar, &
  1902)                           global_auxvar,ss_flow_vol_flux,scale,Res)
  1903)   ! 
  1904)   ! Computes the source/sink terms for the residual
  1905)   ! 
  1906)   ! Author: Paolo Orsini
  1907)   ! Date: 11/04/15
  1908)   ! 
  1909) 
  1910)   use Option_module
  1911)   use Condition_module  
  1912) 
  1913)   use EOS_Water_module
  1914)   use EOS_Oil_module
  1915) 
  1916)   implicit none
  1917) 
  1918)   type(option_type) :: option
  1919)   type(flow_toil_ims_condition_type), pointer :: src_sink_condition
  1920)   type(toil_ims_auxvar_type) :: toil_auxvar
  1921)   type(global_auxvar_type) :: global_auxvar !keep global_auxvar for salinity
  1922)   PetscReal :: ss_flow_vol_flux(option%nphase)
  1923)   PetscReal :: scale  
  1924)   PetscReal :: Res(option%nflowdof)
  1925) 
  1926)   ! local parameter
  1927)   PetscInt, parameter :: SRC_TEMPERATURE = 1
  1928)   PetscInt, parameter :: SRC_ENTHALPY = 2 
  1929)   ! local variables
  1930)   PetscReal, pointer :: qsrc(:)
  1931)   PetscInt :: flow_src_sink_type    
  1932)   PetscReal :: qsrc_mol
  1933)   PetscReal :: den, den_kg, enthalpy, internal_energy, temperature
  1934)   PetscReal :: cell_pressure, dummy_pressure
  1935)   PetscInt :: iphase
  1936)   PetscInt :: energy_var
  1937)   PetscErrorCode :: ierr
  1938) 
  1939)   ! this can be removed when etxending to pressure condition
  1940)   if (.not.associated(src_sink_condition%rate) ) then
  1941)     option%io_buffer = 'TOilImsSrcSink fow condition rate not defined ' // &
  1942)     'rate is needed for a valid src/sink term'
  1943)     call printErrMsg(option)  
  1944)   end if
  1945) 
  1946)   !qsrc => src_sink_condition%rate%dataset%rarray(:)
  1947)   qsrc => src_sink_condition%rate%dataset%rarray
  1948) 
  1949)   energy_var = 0
  1950)   if ( associated(src_sink_condition%temperature) ) then
  1951)     energy_var = SRC_TEMPERATURE 
  1952)   else if ( associated(src_sink_condition%enthalpy) ) then
  1953)     energy_var = SRC_ENTHALPY
  1954)   end if
  1955) 
  1956)   flow_src_sink_type = src_sink_condition%rate%itype
  1957) 
  1958)  ! checks that qsrc(liquid_phase) and qsrc(oil_phase) 
  1959)  ! do not have different signs
  1960)   if ( (qsrc(option%liquid_phase)>0.0d0 .and. qsrc(option%oil_phase)<0.d0).or.&
  1961)       (qsrc(option%liquid_phase)<0.0d0 .and. qsrc(option%oil_phase)>0.d0)  & 
  1962)     ) then
  1963)     option%io_buffer = "TOilImsSrcSink error: " // &
  1964)       "src(wat) and src(oil) with opposite sign"
  1965)     call printErrMsg(option)
  1966)   end if
  1967) 
  1968)   ! approximates BHP with local pressure
  1969)   ! to compute BHP we need to solve an IPR equation
  1970)   if ( ( (flow_src_sink_type == VOLUMETRIC_RATE_SS) .or. &
  1971)          ( associated(src_sink_condition%temperature) ) &
  1972)        ) .and. &
  1973)        (  (qsrc(option%liquid_phase) > 0.d0).or. &
  1974)          (qsrc(option%oil_phase) > 0.d0) &
  1975)        ) & 
  1976)      ) then  
  1977)     cell_pressure = &
  1978)         maxval(toil_auxvar%pres(option%liquid_phase:option%oil_phase))
  1979)   end if
  1980) 
  1981)   ! if enthalpy is used to define enthelpy or energy rate is used  
  1982)   ! approximate bottom hole temperature (BHT) with local temp
  1983)   if ( energy_var == SRC_TEMPERATURE) then
  1984)     temperature = src_sink_condition%temperature%dataset%rarray(1)
  1985)   else   
  1986)     temperature = toil_auxvar%temp
  1987)   end if
  1988) 
  1989) 
  1990)   Res = 0.d0
  1991)   do iphase = 1, option%nphase
  1992)     qsrc_mol = 0.d0
  1993)     if ( qsrc(iphase) > 0.d0) then 
  1994)       select case(iphase)
  1995)         case(LIQUID_PHASE)
  1996)           call EOSWaterDensity(temperature,cell_pressure,den_kg,den,ierr)
  1997)         case(TOIL_IMS_OIL_PHASE)
  1998)             call EOSOilDensity(temperature,cell_pressure,den,ierr)
  1999)       end select 
  2000)     else
  2001)       den = toil_auxvar%den(iphase)
  2002)     end if
  2003) 
  2004)     select case(flow_src_sink_type)
  2005)       ! injection and production 
  2006)       case(MASS_RATE_SS)
  2007)         qsrc_mol = qsrc(iphase)/toil_ims_fmw_comp(iphase) ! kg/sec -> kmol/sec
  2008)       case(SCALED_MASS_RATE_SS)                       ! kg/sec -> kmol/sec
  2009)         qsrc_mol = qsrc(iphase)/toil_ims_fmw_comp(iphase)*scale 
  2010)       case(VOLUMETRIC_RATE_SS)  ! assume local density for now 
  2011)                   ! qsrc(iphase) = m^3/sec  
  2012)         qsrc_mol = qsrc(iphase)*den ! den = kmol/m^3 
  2013)       case(SCALED_VOLUMETRIC_RATE_SS)  ! assume local density for now
  2014)         ! qsrc1 = m^3/sec             ! den = kmol/m^3
  2015)         qsrc_mol = qsrc(iphase)* den * scale
  2016)         !qsrc_mol = qsrc(iphase)*gen_auxvar%den(iphase)*scale 
  2017)     end select
  2018)     ss_flow_vol_flux(iphase) = qsrc_mol/ den
  2019)     Res(iphase) = qsrc_mol
  2020)   enddo
  2021) 
  2022)   ! when using scaled src/sinks, the rates (marr or vol) scaling 
  2023)   ! at this point the scale factor is already included in Res(iphase)
  2024) 
  2025)   ! Res(option%energy_id), energy units: MJ/sec
  2026) 
  2027)   if ( associated(src_sink_condition%temperature) .or. &
  2028)       associated(src_sink_condition%enthalpy) &
  2029)      ) then
  2030)     ! if injection compute local pressure that will be used as BHP
  2031)     ! approximation used to overcome the solution of an IPR
  2032)     !if ( qsrc(option%liquid_phase)>0.d0 .or. 
  2033)     !    qsrc(option%oil_phase)>0.d0 ) then
  2034)     !  cell_pressure = &
  2035)     !      maxval(toil_auxvar%pres(option%liquid_phase:option%oil_phase))
  2036)     !end if
  2037)     ! water injection 
  2038)     if (qsrc(option%liquid_phase) > 0.d0) then !implies qsrc(option%oil_phase)>=0
  2039)       if ( energy_var == SRC_TEMPERATURE ) then
  2040)         call EOSWaterDensity(src_sink_condition%temperature% &
  2041)                              dataset%rarray(1), cell_pressure, &
  2042)                              den_kg,den,ierr)
  2043)         call EOSWaterEnthalpy(src_sink_condition%temperature% &
  2044)                               dataset%rarray(1), cell_pressure, &
  2045)                               enthalpy,ierr)
  2046)         ! enthalpy = [J/kmol]
  2047)       else if ( energy_var == SRC_ENTHALPY ) then
  2048)         !input as J/kg
  2049)         enthalpy = src_sink_condition%enthalpy% &
  2050)                        dataset%rarray(option%liquid_phase)
  2051)                      ! J/kg * kg/kmol = J/kmol  
  2052)         enthalpy = enthalpy * toil_ims_fmw_comp(option%liquid_phase) 
  2053)       end if
  2054)       enthalpy = enthalpy * 1.d-6 ! J/kmol -> whatever units
  2055)       ! enthalpy units: MJ/kmol ! water component mass                     
  2056)       Res(option%energy_id) = Res(option%energy_id) + &
  2057)                               Res(option%liquid_phase) * enthalpy
  2058)     end if
  2059)     ! oil injection 
  2060)     if (qsrc(option%oil_phase) > 0.d0) then !implies qsrc(option%liquid_phase)>=0
  2061)       if ( energy_var == SRC_TEMPERATURE ) then
  2062)         call EOSOilEnthalpy(src_sink_condition%temperature%dataset%rarray(1), &
  2063)                             cell_pressure, enthalpy, ierr)
  2064)         ! enthalpy = [J/kmol] 
  2065)       else if ( energy_var == SRC_ENTHALPY ) then
  2066)         enthalpy = src_sink_condition%enthalpy% &
  2067)                      dataset%rarray(option%oil_phase)
  2068)                       !J/kg * kg/kmol = J/kmol  
  2069)         enthalpy = enthalpy * toil_ims_fmw_comp(option%oil_phase)        
  2070)       end if
  2071)       enthalpy = enthalpy * 1.d-6 ! J/kmol -> whatever units
  2072)       ! enthalpy units: MJ/kmol ! oil component mass                     
  2073)       Res(option%energy_id) = Res(option%energy_id) + &
  2074)                               Res(option%oil_phase) * enthalpy
  2075)     end if
  2076)     ! water energy extraction due to water production
  2077)     if (qsrc(option%liquid_phase) < 0.d0) then !implies qsrc(option%oil_phase)<=0
  2078)       ! auxvar enthalpy units: MJ/kmol ! water component mass                     
  2079)       Res(option%energy_id) = Res(option%energy_id) + &
  2080)                               Res(option%liquid_phase) * &
  2081)                               toil_auxvar%H(option%liquid_phase)
  2082)     end if
  2083)     !oil energy extraction due to oil production 
  2084)     if (qsrc(option%oil_phase) < 0.d0) then !implies qsrc(option%liquid_phase)<=0
  2085)       ! auxvar enthalpy units: MJ/kmol ! water component mass                     
  2086)       Res(option%energy_id) = Res(option%energy_id) + &
  2087)                               Res(option%oil_phase) * &
  2088)                               toil_auxvar%H(option%oil_phase)
  2089)     end if
  2090) 
  2091)   else !if not temp or enthalpy are given
  2092)     ! if energy rate is given, loaded in qsrc(3) in MJ/sec 
  2093)     Res(option%energy_id) = qsrc(THREE_INTEGER)* scale ! MJ/s
  2094)   end if
  2095) 
  2096) 
  2097)   nullify(qsrc)      
  2098)   
  2099) end subroutine TOilImsSrcSink
  2100) 
  2101) ! ************************************************************************** !
  2102) 
  2103) subroutine TOilImsAccumDerivative(toil_auxvar,material_auxvar, &
  2104)                                   soil_heat_capacity,option,J)
  2105)   ! 
  2106)   ! Computes derivatives of the accumulation
  2107)   ! term for the Jacobian
  2108)   ! 
  2109)   ! Author: Paolo Orsini
  2110)   ! Date: 11/06/15
  2111)   ! 
  2112) 
  2113)   use Option_module
  2114)   use Saturation_Function_module
  2115)   use Material_Aux_class
  2116)   
  2117)   implicit none
  2118) 
  2119)   type(toil_ims_auxvar_type) :: toil_auxvar(0:)
  2120)   class(material_auxvar_type) :: material_auxvar
  2121)   type(option_type) :: option
  2122)   PetscReal :: soil_heat_capacity
  2123)   PetscReal :: J(option%nflowdof,option%nflowdof)
  2124)      
  2125)   PetscReal :: res(option%nflowdof), res_pert(option%nflowdof)
  2126)   PetscInt :: idof, irow
  2127) 
  2128)   !print *, 'ToilImsAccumDerivative'
  2129) 
  2130)   call TOilImsAccumulation(toil_auxvar(ZERO_INTEGER), &
  2131)                            material_auxvar,soil_heat_capacity,option,Res)
  2132) 
  2133)   do idof = 1, option%nflowdof
  2134)     call TOilImsAccumulation(toil_auxvar(idof), &
  2135)                            material_auxvar,soil_heat_capacity,option,res_pert)
  2136)     do irow = 1, option%nflowdof
  2137)       J(irow,idof) = (res_pert(irow)-res(irow))/toil_auxvar(idof)%pert
  2138)       !print *, irow, idof, J(irow,idof), toil_auxvar(idof)%pert
  2139)     enddo !irow
  2140)   enddo ! idof
  2141) 
  2142)   if (toil_ims_isothermal) then
  2143)     J(TOIL_IMS_ENERGY_EQUATION_INDEX,:) = 0.d0
  2144)     J(:,TOIL_IMS_ENERGY_EQUATION_INDEX) = 0.d0
  2145)   endif
  2146)   
  2147) !#ifdef DEBUG_GENERAL_FILEOUTPUT
  2148) !  if (debug_flag > 0) then
  2149) !    write(debug_unit,'(a,10es24.15)') 'accum deriv:', J
  2150) !  endif
  2151) !#endif
  2152) 
  2153) end subroutine TOilImsAccumDerivative
  2154) 
  2155) ! ************************************************************************** !
  2156) 
  2157) subroutine ToilImsFluxDerivative(toil_auxvar_up,global_auxvar_up, &
  2158)                                  material_auxvar_up, &
  2159)                                  sir_up, &
  2160)                                  thermal_conductivity_up, &
  2161)                                  toil_auxvar_dn,global_auxvar_dn, &
  2162)                                  material_auxvar_dn, &
  2163)                                  sir_dn, &
  2164)                                  thermal_conductivity_dn, &
  2165)                                  area, dist, &
  2166)                                  toil_parameter, &
  2167)                                  option,Jup,Jdn)
  2168)   ! 
  2169)   ! Computes the derivatives of the internal flux terms
  2170)   ! for the Jacobian
  2171)   ! 
  2172)   ! Author: Paolo Orsini
  2173)   ! Date: 11/06/15
  2174)   ! 
  2175)   use Option_module
  2176)   use Material_Aux_class
  2177)   
  2178)   implicit none
  2179)   
  2180)   type(toil_ims_auxvar_type) :: toil_auxvar_up(0:), toil_auxvar_dn(0:)
  2181)   type(global_auxvar_type) :: global_auxvar_up, global_auxvar_dn
  2182)   class(material_auxvar_type) :: material_auxvar_up, material_auxvar_dn
  2183)   type(option_type) :: option
  2184)   PetscReal :: sir_up(:), sir_dn(:)
  2185)   PetscReal :: thermal_conductivity_dn(2)
  2186)   PetscReal :: thermal_conductivity_up(2)
  2187)   PetscReal :: area
  2188)   PetscReal :: dist(-1:3)
  2189)   type(toil_ims_parameter_type) :: toil_parameter
  2190)   PetscReal :: Jup(option%nflowdof,option%nflowdof), Jdn(option%nflowdof,option%nflowdof)
  2191) 
  2192)   PetscReal :: v_darcy(option%nphase)
  2193)   PetscReal :: res(option%nflowdof), res_pert(option%nflowdof)
  2194)   PetscInt :: idof, irow
  2195) 
  2196)   Jup = 0.d0
  2197)   Jdn = 0.d0
  2198)   
  2199)   !geh:print *, 'ToilImsFluxDerivative'
  2200)   option%iflag = -2
  2201)   call ToilImsFlux(toil_auxvar_up(ZERO_INTEGER),global_auxvar_up, &
  2202)                    material_auxvar_up,sir_up, &
  2203)                    thermal_conductivity_up, &
  2204)                    toil_auxvar_dn(ZERO_INTEGER),global_auxvar_dn, &
  2205)                    material_auxvar_dn,sir_dn, &
  2206)                    thermal_conductivity_dn, &
  2207)                    area,dist,toil_parameter, &
  2208)                    option,v_darcy,res)
  2209)                            
  2210)   ! upgradient derivatives
  2211)   do idof = 1, option%nflowdof
  2212)     call ToilImsFlux(toil_auxvar_up(idof),global_auxvar_up, &
  2213)                      material_auxvar_up,sir_up, &
  2214)                      thermal_conductivity_up, &
  2215)                      toil_auxvar_dn(ZERO_INTEGER),global_auxvar_dn, &
  2216)                      material_auxvar_dn,sir_dn, &
  2217)                      thermal_conductivity_dn, &
  2218)                      area,dist,toil_parameter, &
  2219)                      option,v_darcy,res_pert)
  2220)     do irow = 1, option%nflowdof
  2221)       Jup(irow,idof) = (res_pert(irow)-res(irow))/toil_auxvar_up(idof)%pert
  2222)       !print *, 'up: ', irow, idof, Jup(irow,idof), toil_auxvar_up(idof)%pert
  2223)     enddo !irow
  2224)   enddo ! idof
  2225) 
  2226)   ! downgradient derivatives
  2227)   do idof = 1, option%nflowdof
  2228)     call ToilImsFlux(toil_auxvar_up(ZERO_INTEGER),global_auxvar_up, &
  2229)                      material_auxvar_up,sir_up, &
  2230)                      thermal_conductivity_up, &
  2231)                      toil_auxvar_dn(idof),global_auxvar_dn, &
  2232)                      material_auxvar_dn,sir_dn, &
  2233)                      thermal_conductivity_dn, &
  2234)                      area,dist,toil_parameter, &
  2235)                      option,v_darcy,res_pert)
  2236)     do irow = 1, option%nflowdof
  2237)       Jdn(irow,idof) = (res_pert(irow)-res(irow))/toil_auxvar_dn(idof)%pert
  2238) !geh:print *, 'dn: ', irow, idof, Jdn(irow,idof), gen_auxvar_dn(idof)%pert
  2239)     enddo !irow
  2240)   enddo ! idof
  2241) 
  2242)   if (toil_ims_isothermal) then
  2243)     Jup(TOIL_IMS_ENERGY_EQUATION_INDEX,:) = 0.d0
  2244)     Jup(:,TOIL_IMS_ENERGY_EQUATION_INDEX) = 0.d0
  2245)     Jdn(TOIL_IMS_ENERGY_EQUATION_INDEX,:) = 0.d0
  2246)     Jdn(:,TOIL_IMS_ENERGY_EQUATION_INDEX) = 0.d0
  2247)   endif
  2248)   
  2249) 
  2250) !#ifdef DEBUG_GENERAL_FILEOUTPUT
  2251) !  if (debug_flag > 0) then
  2252) !    write(debug_unit,'(a,20es24.15)') 'flux deriv:', Jup, Jdn
  2253) !  endif
  2254) !#endif
  2255)   
  2256) end subroutine ToilImsFluxDerivative
  2257) 
  2258) ! ************************************************************************** !
  2259) 
  2260) subroutine ToilImsBCFluxDerivative(ibndtype,auxvar_mapping,auxvars, &
  2261)                                    toil_auxvar_up, &
  2262)                                    global_auxvar_up, &
  2263)                                    toil_auxvar_dn,global_auxvar_dn, &
  2264)                                    material_auxvar_dn, &
  2265)                                    sir_dn, &
  2266)                                    thermal_conductivity_dn, &
  2267)                                    area,dist,toil_parameter, &
  2268)                                    option,Jdn)
  2269)   ! 
  2270)   ! Computes the derivatives of the boundary flux terms
  2271)   ! for the Jacobian
  2272)   ! 
  2273)   ! Author: Paolo Orsini
  2274)   ! Date: 11/06/15
  2275)   ! 
  2276) 
  2277)   use Option_module 
  2278)   use Material_Aux_class
  2279)   
  2280)   implicit none
  2281) 
  2282)   PetscReal :: auxvars(:) ! from aux_real_var array
  2283)   type(toil_ims_auxvar_type) :: toil_auxvar_up, toil_auxvar_dn(0:)
  2284)   type(global_auxvar_type) :: global_auxvar_up, global_auxvar_dn
  2285)   class(material_auxvar_type) :: material_auxvar_dn
  2286)   type(option_type) :: option
  2287)   PetscReal :: sir_dn(:)
  2288)   PetscReal :: area
  2289)   PetscReal :: dist(-1:3)
  2290)   type(toil_ims_parameter_type) :: toil_parameter
  2291)   PetscReal :: Jdn(option%nflowdof,option%nflowdof)
  2292)   PetscInt :: ibndtype(1:option%nflowdof)
  2293)   PetscInt :: auxvar_mapping(TOIL_IMS_MAX_INDEX)
  2294)   PetscReal :: thermal_conductivity_dn(2)
  2295) 
  2296)   PetscReal :: v_darcy(option%nphase)
  2297)   PetscReal :: res(option%nflowdof), res_pert(option%nflowdof)
  2298)   PetscInt :: idof, irow
  2299) 
  2300)   Jdn = 0.d0
  2301) !geh:print *, 'GeneralBCFluxDerivative'
  2302) 
  2303)   option%iflag = -2
  2304)   call ToilImsBCFlux(ibndtype,auxvar_mapping,auxvars, &
  2305)                      toil_auxvar_up,global_auxvar_up, &
  2306)                      toil_auxvar_dn(ZERO_INTEGER),global_auxvar_dn, &
  2307)                      material_auxvar_dn, &
  2308)                      sir_dn, &
  2309)                      thermal_conductivity_dn, &
  2310)                      area,dist,toil_parameter, &
  2311)                      option,v_darcy,res)                     
  2312)   ! downgradient derivatives
  2313)   do idof = 1, option%nflowdof
  2314)     call ToilImsBCFlux(ibndtype,auxvar_mapping,auxvars, &
  2315)                        toil_auxvar_up,global_auxvar_up, &
  2316)                        toil_auxvar_dn(idof),global_auxvar_dn, &
  2317)                        material_auxvar_dn, &
  2318)                        sir_dn, &
  2319)                        thermal_conductivity_dn, &
  2320)                        area,dist,toil_parameter, &
  2321)                        option,v_darcy,res_pert)   
  2322)     do irow = 1, option%nflowdof
  2323)       Jdn(irow,idof) = (res_pert(irow)-res(irow))/toil_auxvar_dn(idof)%pert
  2324) !print *, 'bc: ', irow, idof, Jdn(irow,idof), gen_auxvar_dn(idof)%pert
  2325)     enddo !irow
  2326)   enddo ! idof
  2327) 
  2328)   if (toil_ims_isothermal) then
  2329)     Jdn(TOIL_IMS_ENERGY_EQUATION_INDEX,:) = 0.d0
  2330)     Jdn(:,TOIL_IMS_ENERGY_EQUATION_INDEX) = 0.d0
  2331)   endif
  2332)   
  2333)  
  2334) !#ifdef DEBUG_GENERAL_FILEOUTPUT
  2335) !  if (debug_flag > 0) then
  2336) !    write(debug_unit,'(a,10es24.15)') 'bc flux deriv:', Jdn
  2337) !  endif
  2338) !#endif
  2339)   
  2340) end subroutine ToilImsBCFluxDerivative
  2341) 
  2342) 
  2343) ! ************************************************************************** !
  2344) 
  2345) subroutine ToilImsSrcSinkDerivative(option,src_sink_condition, toil_auxvar, &
  2346)                                     global_auxvar,scale,Jac)
  2347)   ! 
  2348)   ! Computes the source/sink terms for the residual
  2349)   ! 
  2350)   ! Author: Paolo Orsini
  2351)   ! Date: 11/06/15
  2352)   ! 
  2353) 
  2354)   use Option_module
  2355)   use Condition_module
  2356) 
  2357)   implicit none
  2358) 
  2359)   type(option_type) :: option
  2360)   type(flow_toil_ims_condition_type), pointer :: src_sink_condition
  2361)   type(toil_ims_auxvar_type) :: toil_auxvar(0:)
  2362)   type(global_auxvar_type) :: global_auxvar
  2363)   PetscReal :: scale
  2364)   PetscReal :: Jac(option%nflowdof,option%nflowdof)
  2365)   
  2366)   PetscReal :: res(option%nflowdof), res_pert(option%nflowdof)
  2367)   PetscReal :: dummy_real(option%nphase)
  2368)   PetscInt :: idof, irow
  2369) 
  2370)   option%iflag = -3
  2371) 
  2372)   call TOilImsSrcSink(option,src_sink_condition,toil_auxvar(ZERO_INTEGER), &
  2373)                           global_auxvar,dummy_real,scale,Res)
  2374) 
  2375)   ! downgradient derivatives
  2376)   do idof = 1, option%nflowdof
  2377) 
  2378)     call TOilImsSrcSink(option,src_sink_condition,toil_auxvar(idof), &
  2379)                         global_auxvar,dummy_real,scale,res_pert)
  2380)   
  2381)     do irow = 1, option%nflowdof
  2382)       Jac(irow,idof) = (res_pert(irow)-res(irow))/toil_auxvar(idof)%pert
  2383)     enddo !irow
  2384)   enddo ! idof
  2385)   
  2386)   if (toil_ims_isothermal) then
  2387)     Jac(TOIL_IMS_ENERGY_EQUATION_INDEX,:) = 0.d0
  2388)     Jac(:,TOIL_IMS_ENERGY_EQUATION_INDEX) = 0.d0
  2389)   endif
  2390)    
  2391) !#ifdef DEBUG_GENERAL_FILEOUTPUT
  2392) !  if (debug_flag > 0) then
  2393) !    write(debug_unit,'(a,20es24.15)') 'src/sink deriv:', Jac
  2394) !  endif
  2395) !#endif
  2396) 
  2397) end subroutine ToilImsSrcSinkDerivative
  2398) 
  2399) ! ************************************************************************** !
  2400) 
  2401) subroutine TOilImsResidual(snes,xx,r,realization,ierr)
  2402)   ! 
  2403)   ! Computes the residual equation
  2404)   ! 
  2405)   ! Author: Paolo Orsini (OGS)
  2406)   ! Date: 11/05/15
  2407)   ! 
  2408) 
  2409)   use Realization_Subsurface_class
  2410)   use Field_module
  2411)   use Patch_module
  2412)   use Discretization_module
  2413)   use Option_module
  2414) 
  2415)   use Connection_module
  2416)   use Grid_module
  2417)   use Coupler_module  
  2418)   use Debug_module
  2419)   use Material_Aux_class
  2420) 
  2421) !#define DEBUG_WITH_TECPLOT
  2422) #ifdef DEBUG_WITH_TECPLOT
  2423)   use Output_Tecplot_module
  2424) #endif
  2425) 
  2426)   implicit none
  2427) 
  2428)   SNES :: snes
  2429)   Vec :: xx
  2430)   Vec :: r
  2431)   type(realization_subsurface_type) :: realization
  2432)   PetscViewer :: viewer
  2433)   PetscErrorCode :: ierr
  2434)   
  2435)   Mat, parameter :: null_mat = 0
  2436)   type(discretization_type), pointer :: discretization
  2437)   type(grid_type), pointer :: grid
  2438)   type(patch_type), pointer :: patch
  2439)   type(option_type), pointer :: option
  2440)   type(field_type), pointer :: field
  2441)   type(coupler_type), pointer :: boundary_condition
  2442)   type(coupler_type), pointer :: source_sink
  2443)   type(material_parameter_type), pointer :: material_parameter
  2444)   
  2445)   type(toil_ims_parameter_type), pointer :: toil_parameter
  2446) 
  2447) 
  2448)   type(toil_ims_auxvar_type), pointer :: toil_auxvars(:,:), toil_auxvars_bc(:)
  2449)   type(global_auxvar_type), pointer :: global_auxvars(:)
  2450)   type(global_auxvar_type), pointer :: global_auxvars_bc(:)
  2451)   type(global_auxvar_type), pointer :: global_auxvars_ss(:)
  2452)   class(material_auxvar_type), pointer :: material_auxvars(:)
  2453)   type(connection_set_list_type), pointer :: connection_set_list
  2454)   type(connection_set_type), pointer :: cur_connection_set
  2455) 
  2456)   PetscInt :: iconn
  2457) 
  2458)   !PetscInt :: iphase
  2459)   
  2460)   PetscReal :: scale
  2461)   PetscReal :: ss_flow_vol_flux(realization%option%nphase)
  2462) 
  2463)   PetscInt :: sum_connection
  2464)   PetscInt :: local_start, local_end
  2465)   PetscInt :: local_id, ghosted_id
  2466)   PetscInt :: local_id_up, local_id_dn, ghosted_id_up, ghosted_id_dn
  2467)   PetscInt :: i, imat, imat_up, imat_dn
  2468)   PetscInt, save :: iplot = 0
  2469) 
  2470)   PetscReal, pointer :: r_p(:)
  2471)   PetscReal, pointer :: accum_p(:), accum_p2(:)
  2472)   
  2473)   character(len=MAXSTRINGLENGTH) :: string
  2474)   character(len=MAXWORDLENGTH) :: word
  2475) 
  2476)   PetscInt :: icap_up, icap_dn
  2477)   PetscReal :: Res(realization%option%nflowdof)
  2478)   PetscReal :: v_darcy(realization%option%nphase)
  2479)   
  2480)   discretization => realization%discretization
  2481)   option => realization%option
  2482)   patch => realization%patch
  2483)   grid => patch%grid
  2484)   field => realization%field
  2485)   material_parameter => patch%aux%Material%material_parameter
  2486)   toil_auxvars => patch%aux%TOil_ims%auxvars
  2487)   toil_auxvars_bc => patch%aux%TOil_ims%auxvars_bc
  2488) 
  2489)   ! for toil_ims specific paramters - currently not used 
  2490)   toil_parameter => patch%aux%Toil_ims%parameter
  2491) 
  2492)   global_auxvars => patch%aux%Global%auxvars
  2493)   global_auxvars_bc => patch%aux%Global%auxvars_bc
  2494)   global_auxvars_ss => patch%aux%Global%auxvars_ss
  2495)   material_auxvars => patch%aux%Material%auxvars
  2496)   
  2497)   ! Communication -----------------------------------------
  2498)   ! These 3 must be called before GeneralUpdateAuxVars()
  2499)   call DiscretizationGlobalToLocal(discretization,xx,field%flow_xx_loc,NFLOWDOF)
  2500)   
  2501)   call TOilImsUpdateAuxVars(realization)
  2502) 
  2503)   ! override flags since they will soon be out of date
  2504)   patch%aux%TOil_ims%auxvars_up_to_date = PETSC_FALSE 
  2505) 
  2506)   ! always assume variables have been swapped; therefore, must copy back
  2507)   ! PO check when copied at the end of iteration - this copy might not
  2508)   ! be needed 
  2509)   call VecLockPop(xx,ierr); CHKERRQ(ierr) !unlock vector from writing
  2510)   call DiscretizationLocalToGlobal(discretization,field%flow_xx_loc,xx, &
  2511)                                    NFLOWDOF)
  2512)   call VecLockPush(xx,ierr); CHKERRQ(ierr) ! block vector from writing 
  2513) 
  2514)   if (option%compute_mass_balance_new) then
  2515)     call TOilImsZeroMassBalanceDelta(realization)
  2516)   endif
  2517) 
  2518)   option%iflag = 1
  2519)   ! now assign access pointer to local variables
  2520)   call VecGetArrayF90(r, r_p, ierr);CHKERRQ(ierr)
  2521) 
  2522)   ! Accumulation terms ------------------------------------
  2523)   ! accumulation at t(k) (doesn't change during Newton iteration)
  2524)   call VecGetArrayReadF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
  2525)   r_p = -accum_p
  2526) 
  2527)   
  2528)   !Heeho dynamically update p+1 accumulation term
  2529)   if (toil_ims_tough2_conv_criteria) then
  2530)     call VecGetArrayReadF90(field%flow_accum2, accum_p2, ierr);CHKERRQ(ierr)
  2531)   endif
  2532)   
  2533)   ! accumulation at t(k+1)
  2534)   do local_id = 1, grid%nlmax  ! For each local node do...
  2535)     ghosted_id = grid%nL2G(local_id)
  2536)     !geh - Ignore inactive cells with inactive materials
  2537)     imat = patch%imat(ghosted_id)
  2538)     if (imat <= 0) cycle
  2539)     local_end = local_id * option%nflowdof
  2540)     local_start = local_end - option%nflowdof + 1
  2541)     call TOilImsAccumulation(toil_auxvars(ZERO_INTEGER,ghosted_id), &
  2542)                               material_auxvars(ghosted_id), &
  2543)                               material_parameter%soil_heat_capacity(imat), &
  2544)                               option,Res) 
  2545)     r_p(local_start:local_end) =  r_p(local_start:local_end) + Res(:)
  2546)     
  2547)     !TOUGH2 conv. creteria: update p+1 accumulation term
  2548)     if (toil_ims_tough2_conv_criteria) then
  2549)       accum_p2(local_start:local_end) = Res(:)
  2550)     endif
  2551)     
  2552)   enddo
  2553) 
  2554)   call VecRestoreArrayReadF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
  2555)   !TOUGH2 conv. creteria: update p+1 accumulation term
  2556)   if (toil_ims_tough2_conv_criteria) then
  2557)     call VecRestoreArrayReadF90(field%flow_accum2, accum_p2, ierr);CHKERRQ(ierr)
  2558)   endif
  2559) 
  2560)   ! Interior Flux Terms -----------------------------------
  2561)   connection_set_list => grid%internal_connection_set_list
  2562)   cur_connection_set => connection_set_list%first
  2563)   sum_connection = 0  
  2564)   do 
  2565)     if (.not.associated(cur_connection_set)) exit
  2566)     do iconn = 1, cur_connection_set%num_connections
  2567)       sum_connection = sum_connection + 1
  2568) 
  2569)       ghosted_id_up = cur_connection_set%id_up(iconn)
  2570)       ghosted_id_dn = cur_connection_set%id_dn(iconn)
  2571) 
  2572)       local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
  2573)       local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping   
  2574) 
  2575)       imat_up = patch%imat(ghosted_id_up) 
  2576)       imat_dn = patch%imat(ghosted_id_dn) 
  2577)       if (imat_up <= 0 .or. imat_dn <= 0) cycle
  2578) 
  2579)       icap_up = patch%sat_func_id(ghosted_id_up)
  2580)       icap_dn = patch%sat_func_id(ghosted_id_dn)
  2581) 
  2582)       call TOilImsFlux(toil_auxvars(ZERO_INTEGER,ghosted_id_up), &
  2583)                        global_auxvars(ghosted_id_up), &
  2584)                        material_auxvars(ghosted_id_up), &
  2585)                        material_parameter%soil_residual_saturation(:,icap_up), &
  2586)                        material_parameter%soil_thermal_conductivity(:,imat_up), &
  2587)                        toil_auxvars(ZERO_INTEGER,ghosted_id_dn), &
  2588)                        global_auxvars(ghosted_id_dn), &
  2589)                        material_auxvars(ghosted_id_dn), &
  2590)                        material_parameter%soil_residual_saturation(:,icap_dn), &
  2591)                        material_parameter%soil_thermal_conductivity(:,imat_dn), &
  2592)                        cur_connection_set%area(iconn), &
  2593)                        cur_connection_set%dist(:,iconn), &
  2594)                        toil_parameter,option,v_darcy,Res)
  2595) 
  2596)       patch%internal_velocities(:,sum_connection) = v_darcy
  2597)       if (associated(patch%internal_flow_fluxes)) then
  2598)         patch%internal_flow_fluxes(:,sum_connection) = Res(:)
  2599)       endif
  2600)       
  2601)       if (local_id_up > 0) then
  2602)         local_end = local_id_up * option%nflowdof
  2603)         local_start = local_end - option%nflowdof + 1
  2604)         r_p(local_start:local_end) = r_p(local_start:local_end) + Res(:)
  2605)       endif
  2606)          
  2607)       if (local_id_dn > 0) then
  2608)         local_end = local_id_dn * option%nflowdof
  2609)         local_start = local_end - option%nflowdof + 1
  2610)         r_p(local_start:local_end) = r_p(local_start:local_end) - Res(:)
  2611)       endif
  2612)     enddo
  2613) 
  2614)     cur_connection_set => cur_connection_set%next
  2615)   enddo    
  2616) 
  2617)   ! Boundary Flux Terms -----------------------------------
  2618)   boundary_condition => patch%boundary_condition_list%first
  2619)   sum_connection = 0    
  2620)   do 
  2621)     if (.not.associated(boundary_condition)) exit
  2622)     
  2623)     cur_connection_set => boundary_condition%connection_set
  2624)     
  2625)     do iconn = 1, cur_connection_set%num_connections
  2626)       sum_connection = sum_connection + 1
  2627)     
  2628)       local_id = cur_connection_set%id_dn(iconn)
  2629)       ghosted_id = grid%nL2G(local_id)
  2630) 
  2631)       imat_dn = patch%imat(ghosted_id)
  2632)       if (imat_dn <= 0) cycle
  2633) 
  2634)       if (ghosted_id<=0) then
  2635)         print *, "Wrong boundary node index... STOP!!!"
  2636)         stop
  2637)       endif
  2638) 
  2639)       icap_dn = patch%sat_func_id(ghosted_id)
  2640) 
  2641)       call TOilImsBCFlux(boundary_condition%flow_bc_type, &
  2642)                      boundary_condition%flow_aux_mapping, &
  2643)                      boundary_condition%flow_aux_real_var(:,iconn), &
  2644)                      toil_auxvars_bc(sum_connection), &
  2645)                      global_auxvars_bc(sum_connection), &
  2646)                      toil_auxvars(ZERO_INTEGER,ghosted_id), &
  2647)                      global_auxvars(ghosted_id), &
  2648)                      material_auxvars(ghosted_id), &
  2649)                      material_parameter%soil_residual_saturation(:,icap_dn), &
  2650)                      material_parameter%soil_thermal_conductivity(:,imat_dn), &
  2651)                      cur_connection_set%area(iconn), &
  2652)                      cur_connection_set%dist(:,iconn), &
  2653)                      toil_parameter,option, &
  2654)                      v_darcy,Res)
  2655) 
  2656)       patch%boundary_velocities(:,sum_connection) = v_darcy
  2657)       if (associated(patch%boundary_flow_fluxes)) then
  2658)         patch%boundary_flow_fluxes(:,sum_connection) = Res(:)
  2659)       endif
  2660)       if (option%compute_mass_balance_new) then
  2661)         ! contribution to boundary
  2662)         global_auxvars_bc(sum_connection)%mass_balance_delta(1:2,1) = &
  2663)           global_auxvars_bc(sum_connection)%mass_balance_delta(1:2,1) - &
  2664)           Res(1:2) ! one-component phase molar fluxes 
  2665)       endif
  2666) 
  2667)       local_end = local_id * option%nflowdof
  2668)       local_start = local_end - option%nflowdof + 1
  2669)       r_p(local_start:local_end)= r_p(local_start:local_end) - Res(:)
  2670) 
  2671)     enddo
  2672)     boundary_condition => boundary_condition%next
  2673)   enddo
  2674) 
  2675)   ! Source/sink terms -------------------------------------
  2676)   source_sink => patch%source_sink_list%first 
  2677)   sum_connection = 0
  2678)   do 
  2679)     if (.not.associated(source_sink)) exit
  2680)     
  2681)     cur_connection_set => source_sink%connection_set
  2682)     
  2683)     do iconn = 1, cur_connection_set%num_connections      
  2684)       sum_connection = sum_connection + 1
  2685)       local_id = cur_connection_set%id_dn(iconn)
  2686)       ghosted_id = grid%nL2G(local_id)
  2687)       if (patch%imat(ghosted_id) <= 0) cycle
  2688) 
  2689)       local_end = local_id * option%nflowdof
  2690)       local_start = local_end - option%nflowdof + 1
  2691) 
  2692)       ! if the src/sink is not scaled, flow_aux_real_var is not allocated
  2693)       ! time varying rate loaded in flow_condition%toil_ims%rate%dataset%rarray(:)  
  2694)       if (associated(source_sink%flow_aux_real_var)) then
  2695)         scale = source_sink%flow_aux_real_var(ONE_INTEGER,iconn)
  2696)       else
  2697)         scale = 1.d0
  2698)       endif
  2699) 
  2700)       call TOilImsSrcSink(option,source_sink%flow_condition%toil_ims, &
  2701)                                 toil_auxvars(ZERO_INTEGER,ghosted_id), &
  2702)                                 global_auxvars(ghosted_id),ss_flow_vol_flux, &
  2703)                                 scale,Res)
  2704) 
  2705)       r_p(local_start:local_end) =  r_p(local_start:local_end) - Res(:)
  2706) 
  2707)       if (associated(patch%ss_flow_vol_fluxes)) then
  2708)         patch%ss_flow_vol_fluxes(:,sum_connection) = ss_flow_vol_flux
  2709)       endif      
  2710)       if (associated(patch%ss_flow_fluxes)) then
  2711)         patch%ss_flow_fluxes(:,sum_connection) = Res(:)
  2712)       endif      
  2713)       if (option%compute_mass_balance_new) then
  2714)         ! src/sinks contribution
  2715)         global_auxvars_ss(sum_connection)%mass_balance_delta(1:2,1) = &
  2716)           global_auxvars_ss(sum_connection)%mass_balance_delta(1:2,1) - &
  2717)           Res(1:2)
  2718)       endif
  2719) 
  2720)     enddo
  2721)     source_sink => source_sink%next
  2722)   enddo
  2723) 
  2724)   if (patch%aux%TOil_ims%inactive_cells_exist) then
  2725)     do i=1,patch%aux%TOil_ims%n_inactive_rows
  2726)       r_p(patch%aux%TOil_ims%inactive_rows_local(i)) = 0.d0
  2727)     enddo
  2728)   endif
  2729)   
  2730)   call VecRestoreArrayF90(r, r_p, ierr);CHKERRQ(ierr)
  2731)   
  2732)   !do not use sandbox
  2733)   !call GeneralSSSandbox(r,null_mat,PETSC_FALSE,grid,material_auxvars, &
  2734)   !                      gen_auxvars,option)
  2735) 
  2736)   !if (Initialized(toil_ims_debug_cell_id)) then
  2737)   !  call VecGetArrayReadF90(r, r_p, ierr);CHKERRQ(ierr)
  2738)   !  do local_id = general_debug_cell_id-1, general_debug_cell_id+1
  2739)   !    write(*,'(''  residual   : '',i2,10es12.4)') local_id, &
  2740)   !      r_p((local_id-1)*option%nflowdof+1:(local_id-1)*option%nflowdof+2), &
  2741)   !      r_p(local_id*option%nflowdof)*1.d6
  2742)   !  enddo
  2743)   !  call VecRestoreArrayReadF90(r, r_p, ierr);CHKERRQ(ierr)
  2744)   !endif
  2745)   
  2746)   if (toil_ims_isothermal) then
  2747)     call VecGetArrayF90(r, r_p, ierr);CHKERRQ(ierr)
  2748)     ! zero energy residual
  2749)     do local_id = 1, grid%nlmax
  2750)       r_p((local_id-1)*option%nflowdof+TOIL_IMS_ENERGY_EQUATION_INDEX) =  0.d0
  2751)     enddo
  2752)     call VecRestoreArrayF90(r, r_p, ierr);CHKERRQ(ierr)
  2753)   endif
  2754) 
  2755)   
  2756)   if (realization%debug%vecview_residual) then
  2757)     string = 'Gresidual'
  2758)     call DebugCreateViewer(realization%debug,string,option,viewer)
  2759)     call VecView(r,viewer,ierr);CHKERRQ(ierr)
  2760)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  2761)   endif
  2762)   if (realization%debug%vecview_solution) then
  2763)     string = 'Gxx'
  2764)     call DebugCreateViewer(realization%debug,string,option,viewer)
  2765)     call VecView(xx,viewer,ierr);CHKERRQ(ierr)
  2766)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  2767)   endif
  2768) 
  2769)   
  2770) end subroutine TOilImsResidual
  2771) 
  2772) ! ************************************************************************** !
  2773) 
  2774) ! ************************************************************************** !
  2775) 
  2776) subroutine TOilImsJacobian(snes,xx,A,B,realization,ierr)
  2777)   ! 
  2778)   ! Computes the Jacobian for TOilIms Mode
  2779)   ! 
  2780)   ! Author: Paolo Orsini
  2781)   ! Date: 11/05/15
  2782)   ! 
  2783) 
  2784)   use Realization_Subsurface_class
  2785)   use Patch_module
  2786)   use Grid_module
  2787)   use Option_module
  2788)   use Connection_module
  2789)   use Coupler_module
  2790)   use Field_module
  2791)   use Debug_module
  2792)   use Material_Aux_class
  2793) 
  2794)   implicit none
  2795) 
  2796)   SNES :: snes
  2797)   Vec :: xx
  2798)   Mat :: A, B
  2799)   type(realization_subsurface_type) :: realization
  2800)   PetscErrorCode :: ierr
  2801) 
  2802)   Mat :: J
  2803)   MatType :: mat_type
  2804)   PetscReal :: norm
  2805)   PetscViewer :: viewer
  2806) 
  2807)   PetscInt :: icap_up,icap_dn
  2808)   PetscReal :: qsrc, scale
  2809)   PetscInt :: imat, imat_up, imat_dn
  2810)   PetscInt :: local_id, ghosted_id
  2811)   PetscInt :: irow
  2812)   PetscInt :: local_id_up, local_id_dn
  2813)   PetscInt :: ghosted_id_up, ghosted_id_dn
  2814)   Vec, parameter :: null_vec = 0
  2815)   
  2816)   PetscReal :: Jup(realization%option%nflowdof,realization%option%nflowdof), &
  2817)                Jdn(realization%option%nflowdof,realization%option%nflowdof)
  2818)   
  2819)   type(coupler_type), pointer :: boundary_condition, source_sink
  2820)   type(connection_set_list_type), pointer :: connection_set_list
  2821)   type(connection_set_type), pointer :: cur_connection_set
  2822)   PetscInt :: iconn
  2823)   PetscInt :: sum_connection  
  2824)   PetscReal :: distance, fraction_upwind
  2825)   PetscReal :: distance_gravity 
  2826)   PetscInt, pointer :: zeros(:)
  2827)   type(grid_type), pointer :: grid
  2828)   type(patch_type), pointer :: patch
  2829)   type(option_type), pointer :: option 
  2830)   type(field_type), pointer :: field 
  2831)   type(material_parameter_type), pointer :: material_parameter
  2832)   type(toil_ims_parameter_type), pointer :: toil_parameter
  2833)   type(toil_ims_auxvar_type), pointer :: toil_auxvars(:,:), toil_auxvars_bc(:)
  2834)   type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:) 
  2835)   class(material_auxvar_type), pointer :: material_auxvars(:)
  2836)   
  2837)   character(len=MAXSTRINGLENGTH) :: string
  2838)   character(len=MAXWORDLENGTH) :: word
  2839)   
  2840)   patch => realization%patch
  2841)   grid => patch%grid
  2842)   option => realization%option
  2843)   field => realization%field
  2844)   material_parameter => patch%aux%Material%material_parameter
  2845)   toil_auxvars => patch%aux%TOil_ims%auxvars
  2846)   toil_auxvars_bc => patch%aux%TOil_ims%auxvars_bc
  2847)   toil_parameter => patch%aux%TOil_ims%parameter
  2848)   global_auxvars => patch%aux%Global%auxvars
  2849)   global_auxvars_bc => patch%aux%Global%auxvars_bc
  2850)   material_auxvars => patch%aux%Material%auxvars
  2851) 
  2852)   call MatGetType(A,mat_type,ierr);CHKERRQ(ierr)
  2853)   if (mat_type == MATMFFD) then
  2854)     J = B
  2855)     call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  2856)     call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  2857)   else
  2858)     J = A
  2859)   endif
  2860) 
  2861)   call MatZeroEntries(J,ierr);CHKERRQ(ierr)
  2862) 
  2863) !#ifdef DEBUG_GENERAL_FILEOUTPUT
  2864) !  if (debug_flag > 0) then
  2865) !    write(word,*) debug_timestep_count
  2866) !    string = 'jacobian_debug_data_' // trim(adjustl(word))
  2867) !    write(word,*) debug_timestep_cut_count
  2868) !    string = trim(string) // '_' // trim(adjustl(word))
  2869) !    write(word,*) debug_iteration_count
  2870) !    debug_filename = trim(string) // '_' // trim(adjustl(word)) // '.txt'
  2871) !    open(debug_unit, file=debug_filename, action="write", status="unknown")
  2872) !    open(debug_info_unit, file='debug_info.txt', action="write", &
  2873) !         position="append", status="unknown")
  2874) !    write(debug_info_unit,*) 'jacobian ', debug_timestep_count, &
  2875) !      debug_timestep_cut_count, debug_iteration_count
  2876) !    close(debug_info_unit)
  2877) !  endif
  2878) !#endif
  2879) 
  2880)   ! Perturb aux vars
  2881)   do ghosted_id = 1, grid%ngmax  ! For each local node do...
  2882)     if (patch%imat(ghosted_id) <= 0) cycle
  2883) 
  2884)     call TOilImsAuxVarPerturb(toil_auxvars(:,ghosted_id), &
  2885)                               global_auxvars(ghosted_id), &
  2886)                               material_auxvars(ghosted_id), &
  2887)                               patch%characteristic_curves_array( &
  2888)                                patch%sat_func_id(ghosted_id))%ptr, &
  2889)                               ghosted_id,option)
  2890)   enddo
  2891)   
  2892) !#ifdef DEBUG_GENERAL_LOCAL
  2893) !  call GeneralOutputAuxVars(gen_auxvars,global_auxvars,option)
  2894) !#endif 
  2895) 
  2896)   ! Accumulation terms ------------------------------------
  2897)   do local_id = 1, grid%nlmax  ! For each local node do...
  2898)     ghosted_id = grid%nL2G(local_id)
  2899)     !geh - Ignore inactive cells with inactive materials
  2900)     imat = patch%imat(ghosted_id)
  2901)     if (imat <= 0) cycle
  2902) 
  2903)     call TOilImsAccumDerivative(toil_auxvars(:,ghosted_id), &
  2904)                                 material_auxvars(ghosted_id), &
  2905)                                 material_parameter%soil_heat_capacity(imat), & 
  2906)                                 option,Jup)
  2907) 
  2908)     call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jup, &
  2909)                                   ADD_VALUES,ierr);CHKERRQ(ierr)
  2910)   enddo
  2911) 
  2912)   if (realization%debug%matview_Jacobian_detailed) then
  2913)     call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  2914)     call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  2915)     string = 'jacobian_accum'
  2916)     call DebugCreateViewer(realization%debug,string,option,viewer)
  2917)     call MatView(A,viewer,ierr);CHKERRQ(ierr)
  2918)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  2919)   endif
  2920) 
  2921) 
  2922)   ! Interior Flux Terms -----------------------------------  
  2923)   connection_set_list => grid%internal_connection_set_list
  2924)   cur_connection_set => connection_set_list%first
  2925)   sum_connection = 0    
  2926)   do 
  2927)     if (.not.associated(cur_connection_set)) exit
  2928)     do iconn = 1, cur_connection_set%num_connections
  2929)       sum_connection = sum_connection + 1
  2930)     
  2931)       ghosted_id_up = cur_connection_set%id_up(iconn)
  2932)       ghosted_id_dn = cur_connection_set%id_dn(iconn)
  2933) 
  2934)       imat_up = patch%imat(ghosted_id_up)
  2935)       imat_dn = patch%imat(ghosted_id_dn)
  2936)       if (imat_up <= 0 .or. imat_dn <= 0) cycle
  2937) 
  2938)       local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
  2939)       local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping   
  2940)    
  2941)       icap_up = patch%sat_func_id(ghosted_id_up)
  2942)       icap_dn = patch%sat_func_id(ghosted_id_dn)
  2943)                               
  2944)       call TOilImsFluxDerivative(toil_auxvars(:,ghosted_id_up), &
  2945)                        global_auxvars(ghosted_id_up), &
  2946)                        material_auxvars(ghosted_id_up), &
  2947)                        material_parameter%soil_residual_saturation(:,icap_up), &
  2948)                        material_parameter%soil_thermal_conductivity(:,imat_up), &
  2949)                        toil_auxvars(:,ghosted_id_dn), &
  2950)                        global_auxvars(ghosted_id_dn), &
  2951)                        material_auxvars(ghosted_id_dn), &
  2952)                        material_parameter%soil_residual_saturation(:,icap_dn), &
  2953)                        material_parameter%soil_thermal_conductivity(:,imat_dn), &
  2954)                        cur_connection_set%area(iconn), &
  2955)                        cur_connection_set%dist(:,iconn), &
  2956)                        toil_parameter,option, &
  2957)                        Jup,Jdn)
  2958)      
  2959)       if (local_id_up > 0) then
  2960)         call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_up-1, &
  2961)                                       Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
  2962)         call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_dn-1, &
  2963)                                       Jdn,ADD_VALUES,ierr);CHKERRQ(ierr)
  2964)       endif
  2965)       if (local_id_dn > 0) then
  2966)         Jup = -Jup
  2967)         Jdn = -Jdn
  2968)         call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_dn-1, &
  2969)                                       Jdn,ADD_VALUES,ierr);CHKERRQ(ierr)
  2970)         call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_up-1, &
  2971)                                       Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
  2972)       endif
  2973)     enddo
  2974)     cur_connection_set => cur_connection_set%next
  2975)   enddo
  2976) 
  2977)   if (realization%debug%matview_Jacobian_detailed) then
  2978)     call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  2979)     call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  2980)     string = 'jacobian_flux'
  2981)     call DebugCreateViewer(realization%debug,string,option,viewer)
  2982)     call MatView(A,viewer,ierr);CHKERRQ(ierr)
  2983)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  2984)   endif
  2985) 
  2986)   ! Boundary Flux Terms -----------------------------------
  2987)   boundary_condition => patch%boundary_condition_list%first
  2988)   sum_connection = 0    
  2989)   do 
  2990)     if (.not.associated(boundary_condition)) exit
  2991)     
  2992)     cur_connection_set => boundary_condition%connection_set
  2993)     
  2994)     do iconn = 1, cur_connection_set%num_connections
  2995)       sum_connection = sum_connection + 1
  2996)     
  2997)       local_id = cur_connection_set%id_dn(iconn)
  2998)       ghosted_id = grid%nL2G(local_id)
  2999) 
  3000)       imat_dn = patch%imat(ghosted_id)
  3001)       if (imat_dn <= 0) cycle
  3002) 
  3003)       if (ghosted_id<=0) then
  3004)         print *, "Wrong boundary node index... STOP!!!"
  3005)         stop
  3006)       endif
  3007) 
  3008)       icap_dn = patch%sat_func_id(ghosted_id)
  3009) 
  3010)       call TOilImsBCFluxDerivative(boundary_condition%flow_bc_type, &
  3011)                      boundary_condition%flow_aux_mapping, &
  3012)                      boundary_condition%flow_aux_real_var(:,iconn), &
  3013)                      toil_auxvars_bc(sum_connection), &
  3014)                      global_auxvars_bc(sum_connection), &
  3015)                      toil_auxvars(:,ghosted_id), &
  3016)                      global_auxvars(ghosted_id), &
  3017)                      material_auxvars(ghosted_id), &
  3018)                      material_parameter%soil_residual_saturation(:,icap_dn), &
  3019)                      material_parameter%soil_thermal_conductivity(:,imat_dn), &
  3020)                      cur_connection_set%area(iconn), &
  3021)                      cur_connection_set%dist(:,iconn), &
  3022)                      toil_parameter,option, &
  3023)                      Jdn)
  3024) 
  3025)       Jdn = -Jdn
  3026)       call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jdn, &
  3027)                                     ADD_VALUES,ierr);CHKERRQ(ierr)
  3028)     enddo
  3029)     boundary_condition => boundary_condition%next
  3030)   enddo
  3031) 
  3032)   if (realization%debug%matview_Jacobian_detailed) then
  3033)     call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3034)     call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3035)     string = 'jacobian_bcflux'
  3036)     call DebugCreateViewer(realization%debug,string,option,viewer)
  3037)     call MatView(A,viewer,ierr);CHKERRQ(ierr)
  3038)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  3039)   endif
  3040) 
  3041)   ! Source/sinks
  3042)   source_sink => patch%source_sink_list%first 
  3043)   do 
  3044)     if (.not.associated(source_sink)) exit
  3045)     
  3046)     cur_connection_set => source_sink%connection_set
  3047)     
  3048)     do iconn = 1, cur_connection_set%num_connections      
  3049)       local_id = cur_connection_set%id_dn(iconn)
  3050)       ghosted_id = grid%nL2G(local_id)
  3051)       if (patch%imat(ghosted_id) <= 0) cycle
  3052) 
  3053)       if (associated(source_sink%flow_aux_real_var)) then
  3054)         scale = source_sink%flow_aux_real_var(ONE_INTEGER,iconn)
  3055)       else
  3056)         scale = 1.d0
  3057)       endif
  3058)       
  3059)       Jup = 0.d0
  3060) 
  3061)       call TOilImsSrcSinkDerivative(option, &
  3062)                         source_sink%flow_condition%toil_ims, &
  3063)                         toil_auxvars(:,ghosted_id), &
  3064)                         global_auxvars(ghosted_id), &
  3065)                         scale,Jup)
  3066) 
  3067)       call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jup, &
  3068)                                     ADD_VALUES,ierr);CHKERRQ(ierr)
  3069) 
  3070)     enddo
  3071)     source_sink => source_sink%next
  3072)   enddo
  3073)    
  3074)   ! SSSandBox not supported 
  3075)   !call GeneralSSSandbox(null_vec,A,PETSC_TRUE,grid,material_auxvars, &
  3076)   !                      gen_auxvars,option)
  3077) 
  3078)   if (realization%debug%matview_Jacobian_detailed) then
  3079)     call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3080)     call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3081)     string = 'jacobian_srcsink'
  3082)     call DebugCreateViewer(realization%debug,string,option,viewer)
  3083)     call MatView(A,viewer,ierr);CHKERRQ(ierr)
  3084)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  3085)   endif
  3086)   
  3087)   call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3088)   call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3089) 
  3090)   ! zero out isothermal and inactive cells
  3091)   if (patch%aux%TOil_ims%inactive_cells_exist) then
  3092)     qsrc = 1.d0 ! solely a temporary variable in this conditional
  3093)     call MatZeroRowsLocal(A,patch%aux%TOil_ims%n_inactive_rows, &
  3094)                           patch%aux%TOil_ims%inactive_rows_local_ghosted, &
  3095)                           qsrc,PETSC_NULL_OBJECT,PETSC_NULL_OBJECT, &
  3096)                           ierr);CHKERRQ(ierr)
  3097)   endif
  3098) 
  3099)   if (toil_ims_isothermal) then
  3100)     qsrc = 1.d0 ! solely a temporary variable in this conditional
  3101)     zeros => patch%aux%Toil_ims%row_zeroing_array
  3102)     ! zero energy residual
  3103)     do local_id = 1, grid%nlmax
  3104)       ghosted_id = grid%nL2G(local_id)
  3105)       zeros(local_id) = (ghosted_id-1)*option%nflowdof+ &
  3106)                         TOIL_IMS_ENERGY_EQUATION_INDEX - 1 ! zero-based
  3107)     enddo
  3108)     call MatZeroRowsLocal(A,grid%nlmax,zeros,qsrc,PETSC_NULL_OBJECT, &
  3109)                           PETSC_NULL_OBJECT,ierr);CHKERRQ(ierr)
  3110)   endif
  3111) 
  3112)   if (realization%debug%matview_Jacobian) then
  3113)     string = 'Gjacobian'
  3114)     call DebugCreateViewer(realization%debug,string,option,viewer)
  3115)     call MatView(J,viewer,ierr);CHKERRQ(ierr)
  3116)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  3117)   endif
  3118)   if (realization%debug%norm_Jacobian) then
  3119)     option => realization%option
  3120)     call MatNorm(J,NORM_1,norm,ierr);CHKERRQ(ierr)
  3121)     write(option%io_buffer,'("1 norm: ",es11.4)') norm
  3122)     call printMsg(option) 
  3123)     call MatNorm(J,NORM_FROBENIUS,norm,ierr);CHKERRQ(ierr)
  3124)     write(option%io_buffer,'("2 norm: ",es11.4)') norm
  3125)     call printMsg(option) 
  3126)     call MatNorm(J,NORM_INFINITY,norm,ierr);CHKERRQ(ierr)
  3127)     write(option%io_buffer,'("inf norm: ",es11.4)') norm
  3128)     call printMsg(option) 
  3129)   endif
  3130) 
  3131) !  call MatView(J,PETSC_VIEWER_STDOUT_WORLD,ierr)
  3132) 
  3133) !#if 0
  3134) !  imat = 1
  3135) !  if (imat == 1) then
  3136) !    call GeneralNumericalJacobianTest(xx,realization,J) 
  3137) !  endif
  3138) !#endif
  3139) 
  3140) !#ifdef DEBUG_GENERAL_FILEOUTPUT
  3141) !  if (debug_flag > 0) then
  3142) !    write(word,*) debug_timestep_count
  3143) !    string = 'jacobian_' // trim(adjustl(word))
  3144) !    write(word,*) debug_timestep_cut_count
  3145) !    string = trim(string) // '_' // trim(adjustl(word))
  3146) !    write(word,*) debug_iteration_count
  3147) !    string = trim(string) // '_' // trim(adjustl(word)) // '.out'
  3148) !    call PetscViewerASCIIOpen(realization%option%mycomm,trim(string), &
  3149) !                              viewer,ierr);CHKERRQ(ierr)
  3150) !    call MatView(J,viewer,ierr);CHKERRQ(ierr)
  3151) !    call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  3152) !    close(debug_unit)
  3153) !  endif
  3154) !#endif
  3155) 
  3156) end subroutine ToilImsJacobian
  3157) 
  3158) ! ************************************************************************** !
  3159) 
  3160) subroutine TOilImsDestroy(realization)
  3161)   ! 
  3162)   ! Deallocates variables associated with TOilIms
  3163)   ! 
  3164)   ! Author: Paolo Orsini
  3165)   ! Date: 11/09/15
  3166)   ! 
  3167) 
  3168)   use Realization_Subsurface_class
  3169) 
  3170)   implicit none
  3171) 
  3172)   type(realization_subsurface_type) :: realization
  3173)   
  3174)   ! place anything that needs to be freed here.
  3175)   ! auxvars are deallocated in auxiliary.F90.
  3176) 
  3177) end subroutine TOilImsDestroy
  3178) 
  3179) ! ************************************************************************** !
  3180) 
  3181) ! ************************************************************************** !
  3182) ! PO rewritten again by mistake!!!! need comment it out
  3183) !    in this version the write statements for debugging from General 
  3184) !    appear commented 
  3185) !subroutine ToilImsCheckUpdatePre(line_search,X,dX,changed,realization,ierr)
  3186) !  ! 
  3187) !  ! Checks update prior to update
  3188) !  ! 
  3189) !  ! Author: Paolo Orsini
  3190) !  ! Date: 11/05/15
  3191) !  ! 
  3192) !
  3193) !  use Realization_Subsurface_class
  3194) !  use Grid_module
  3195) !  use Field_module
  3196) !  use Option_module
  3197) !  use Saturation_Function_module
  3198) !  use Patch_module
  3199) ! 
  3200) !  implicit none
  3201) !  
  3202) !  SNESLineSearch :: line_search
  3203) !  Vec :: X
  3204) !  Vec :: dX
  3205) !  PetscBool :: changed
  3206) !  type(realization_subsurface_type) :: realization
  3207) !  
  3208) !  PetscReal, pointer :: X_p(:)
  3209) !  PetscReal, pointer :: dX_p(:)
  3210) !  PetscReal, pointer :: r_p(:)
  3211) !  type(grid_type), pointer :: grid
  3212) !  type(option_type), pointer :: option
  3213) !  type(patch_type), pointer :: patch
  3214) !  type(field_type), pointer :: field
  3215) !  type(toil_ims_auxvar_type), pointer :: toil_auxvars(:,:)
  3216) !  type(global_auxvar_type), pointer :: global_auxvars(:)  
  3217) !
  3218) !  PetscInt :: local_id, ghosted_id
  3219) !  PetscInt :: offset
  3220) !
  3221) !  PetscInt :: pressure_index, saturation_index, temperature_index 
  3222) !  PetscReal :: pressure0, pressure1, del_pressure
  3223) !  PetscReal :: temperature0, temperature1, del_temperature
  3224) !  PetscReal :: saturation0, saturation1, del_saturation
  3225) 
  3226) !  PetscReal :: max_saturation_change = 0.125d0
  3227) !  PetscReal :: max_temperature_change = 10.d0
  3228) !  PetscReal :: min_pressure
  3229) !  PetscReal :: scale, temp_scale, temp_real
  3230) !  PetscReal, parameter :: tolerance = 0.99d0
  3231) !  PetscReal, parameter :: initial_scale = 1.d0
  3232) !  SNES :: snes
  3233) !  PetscInt :: newton_iteration
  3234) !  PetscErrorCode :: ierr
  3235) !  
  3236) !  grid => realization%patch%grid
  3237) !  option => realization%option
  3238) !  field => realization%field
  3239) !  toil_auxvars => realization%patch%aux%TOil_Ims%auxvars
  3240) !  global_auxvars => realization%patch%aux%Global%auxvars
  3241) !
  3242) !  patch => realization%patch
  3243) !
  3244) !  call SNESLineSearchGetSNES(line_search,snes,ierr)
  3245) !  call SNESGetIterationNumber(snes,newton_iteration,ierr)
  3246) !
  3247) !  call VecGetArrayF90(dX,dX_p,ierr);CHKERRQ(ierr)
  3248) !  call VecGetArrayReadF90(X,X_p,ierr);CHKERRQ(ierr)
  3249) !
  3250) !  changed = PETSC_TRUE
  3251) !
  3252) !  scale = initial_scale
  3253) !      
  3254) !  if (toil_ims_max_it_before_damping > 0 .and. &
  3255) !      newton_iteration > toil_ims_max_it_before_damping) then
  3256) !    scale = toil_ims_damping_factor
  3257) !  endif
  3258) !
  3259) !#define LIMIT_MAX_PRESSURE_CHANGE
  3260) !#define LIMIT_MAX_SATURATION_CHANGE
  3261) !!#define TRUNCATE_PRESSURE
  3262) 
  3263) !!!#define LIMIT_MAX_TEMPERATURE_CHANGE
  3264) !!#define TRUNCATE_LIQUID_PRESSURE
  3265) !!! TRUNCATE_GAS/AIR_PRESSURE is needed for times when the solve wants
  3266) !!! to pull them negative.
  3267) !!#define TRUNCATE_GAS_PRESSURE
  3268) !!#define TRUNCATE_AIR_PRESSURE
  3269) !
  3270) !  ! scaling
  3271) !  do local_id = 1, grid%nlmax
  3272) !    ghosted_id = grid%nL2G(local_id)
  3273) !    offset = (local_id-1)*option%nflowdof
  3274) !    temp_scale = 1.d0
  3275) !
  3276) !!#ifdef DEBUG_GENERAL_INFO
  3277) !!    cell_id = grid%nG2A(ghosted_id)
  3278) !!    write(cell_id_word,*) cell_id
  3279) !!    cell_id_word = '(Cell ' // trim(adjustl(cell_id_word)) // '): '
  3280) !!#endif
  3281) !
  3282) !    pressure_index = offset + TOIL_IMS_PRESSURE_DOF
  3283) !    saturation_index = offset + TOIL_IMS_SATURATION_DOF
  3284) !    temperature_index  = offset + TOIL_IMS_ENERGY_DOF
  3285) !    dX_p(pressure_index) = dX_p(pressure_index) * &
  3286) !                                toil_ims_pressure_scale
  3287) !    temp_scale = 1.d0
  3288) !    del_pressure = dX_p(pressure_index)
  3289) !    pressure0 = X_p(pressure_index)
  3290) !    pressure1 = pressure0 - del_pressure
  3291) !    del_saturation = dX_p(saturation_index)
  3292) !    saturation0 = X_p(saturation_index)
  3293) !    saturation1 = saturation0 - del_saturation
  3294) !
  3295) !#ifdef LIMIT_MAX_PRESSURE_CHANGE
  3296) !    if (dabs(del_pressure) > toil_ims_max_pressure_change) then
  3297) !      temp_real = dabs(toil_ims_max_pressure_change/del_pressure)
  3298) !!#ifdef DEBUG_GENERAL_INFO
  3299) !!          if (cell_locator(0) < max_cell_id) then
  3300) !!            cell_locator(0) = cell_locator(0) + 1
  3301) !!            cell_locator(cell_locator(0)) = ghosted_id
  3302) !!          endif
  3303) !!          string = trim(cell_id_word) // &
  3304) !!            'Gas pressure change scaled to truncate at max_pressure_change: '
  3305) !!          call printMsg(option,string)
  3306) !!          write(string2,*) gas_pressure0
  3307) !!          string = '  Gas Pressure 0    : ' // adjustl(string2)
  3308) !!          call printMsg(option,string)
  3309) !!          write(string2,*) gas_pressure1
  3310) !!          string = '  Gas Pressure 1    : ' // adjustl(string2)
  3311) !!          call printMsg(option,string)
  3312) !!          write(string2,*) -1.d0*del_gas_pressure
  3313) !!          string = 'Gas Pressure change : ' // adjustl(string2)
  3314) !!          call printMsg(option,string)
  3315) !!          write(string2,*) temp_real
  3316) !!          string = '          scaling  : ' // adjustl(string2)
  3317) !!          call printMsg(option,string)
  3318) !!#endif
  3319) !      temp_scale = min(temp_scale,temp_real)
  3320) !    endif
  3321) !#endif !LIMIT_MAX_PRESSURE_CHANGE
  3322) !
  3323) !#ifdef TRUNCATE_PRESSURE
  3324) !    if (pressure1 <= 0.d0) then
  3325) !      if (dabs(del_pressure) > 1.d-40) then
  3326) !        temp_real = tolerance * dabs(pressure0 / del_pressure)
  3327) !!#ifdef DEBUG_GENERAL_INFO
  3328) !!            if (cell_locator(0) < max_cell_id) then
  3329) !!              cell_locator(0) = cell_locator(0) + 1
  3330) !!              cell_locator(cell_locator(0)) = ghosted_id
  3331) !!            endif
  3332) !!            string = trim(cell_id_word) // &
  3333) !!              'Gas pressure change scaled to prevent gas ' // &
  3334) !!              'pressure from dropping below zero: '
  3335) !!            call printMsg(option,string)
  3336) !!            write(string2,*) gas_pressure0
  3337) !!            string = '  Gas pressure 0   : ' // adjustl(string2)
  3338) !!            call printMsg(option,string)
  3339) !!            write(string2,*) gas_pressure1
  3340) !!            string = '  Gas pressure 1   : ' // adjustl(string2)
  3341) !!            call printMsg(option,string)
  3342) !!            write(string2,*) -1.d0*del_gas_pressure
  3343) !!            string = '  pressure change  : ' // adjustl(string2)
  3344) !!            call printMsg(option,string)
  3345) !!            write(string2,*) temp_real
  3346) !!            string = '          scaling  : ' // adjustl(string2)
  3347) !!            call printMsg(option,string)
  3348) !!#endif
  3349) !        temp_scale = min(temp_scale,temp_real)
  3350) !      endif
  3351) !    endif
  3352) !#endif !TRUNCATE_PRESSURE
  3353) !
  3354) !#ifdef LIMIT_MAX_SATURATION_CHANGE
  3355) !    if (dabs(del_saturation) > max_saturation_change) then
  3356) !      temp_real = dabs(max_saturation_change/del_saturation)
  3357) !!#ifdef DEBUG_GENERAL_INFO
  3358) !!          if (cell_locator(0) < max_cell_id) then
  3359) !!            cell_locator(0) = cell_locator(0) + 1
  3360) !!            cell_locator(cell_locator(0)) = ghosted_id
  3361) !!          endif
  3362) !!          string = trim(cell_id_word) // &
  3363) !!            'Gas saturation change scaled to truncate at ' // &
  3364) !!            'max_saturation_change: '
  3365) !!          call printMsg(option,string)
  3366) !!          write(string2,*) saturation0
  3367) !!          string = '  Saturation 0    : ' // adjustl(string2)
  3368) !!          call printMsg(option,string)
  3369) !!          write(string2,*) saturation1
  3370) !!          string = '  Saturation 1    : ' // adjustl(string2)
  3371) !!          call printMsg(option,string)
  3372) !!          write(string2,*) -1.d0*del_saturation
  3373) !!          string = 'Saturation change : ' // adjustl(string2)
  3374) !!          call printMsg(option,string)
  3375) !!          write(string2,*) temp_real
  3376) !!          string = '          scaling  : ' // adjustl(string2)
  3377) !!          call printMsg(option,string)
  3378) !!#endif
  3379) !      temp_scale = min(temp_scale,temp_real)
  3380) !    endif
  3381) !#endif !LIMIT_MAX_SATURATION_CHANGE        
  3382) !
  3383) !    scale = min(scale,temp_scale) 
  3384) !  enddo
  3385) !
  3386) !  temp_scale = scale
  3387) !  call MPI_Allreduce(temp_scale,scale,ONE_INTEGER_MPI, &
  3388) !                     MPI_DOUBLE_PRECISION, &
  3389) !                     MPI_MIN,option%mycomm,ierr)
  3390) !
  3391) !
  3392) !  if (scale < 0.9999d0) then
  3393) !!#ifdef DEBUG_GENERAL_INFO
  3394) !!    string  = '++++++++++++++++++++++++++++++++++++++++++++++++++++++'
  3395) !!    call printMsg(option,string)
  3396) !!    write(string2,*) scale, (grid%nG2A(cell_locator(i)),i=1,cell_locator(0))
  3397) !!    string = 'Final scaling: : ' // adjustl(string2)
  3398) !!    call printMsg(option,string)
  3399) !!    do i = 1, cell_locator(0)
  3400) !!      ghosted_id = cell_locator(i)
  3401) !!      offset = (ghosted_id-1)*option%nflowdof
  3402) !!      write(string2,*) grid%nG2A(ghosted_id)
  3403) !!      string = 'Cell ' // trim(adjustl(string2))
  3404) !!      write(string2,*) global_auxvars(ghosted_id)%istate
  3405) !!      string = trim(string) // ' (State = ' // trim(adjustl(string2)) // ') '
  3406) !!      call printMsg(option,string)
  3407) !!      ! for some reason cannot perform array operation on dX_p(:)
  3408) !!      write(string2,*) (X_p(offset+ii),ii=1,3)
  3409) !!      string = '   Orig. Solution: ' // trim(adjustl(string2))
  3410) !!      call printMsg(option,string)
  3411) !!      write(string2,*) (X_p(offset+ii)-dX_p(offset+ii),ii=1,3)
  3412) !!      string = '  Solution before: ' // trim(adjustl(string2))
  3413) !!      call printMsg(option,string)
  3414) !!      write(string2,*) (X_p(offset+ii)-scale*dX_p(offset+ii),ii=1,3)
  3415) !!      string = '   Solution after: ' // trim(adjustl(string2))
  3416) !!      call printMsg(option,string)
  3417) !!    enddo
  3418) !!    string  = '++++++++++++++++++++++++++++++++++++++++++++++++++++++'
  3419) !!    call printMsg(option,string)
  3420) !!#endif
  3421) !    dX_p = scale*dX_p
  3422) !  endif
  3423) !
  3424) !  call VecRestoreArrayF90(dX,dX_p,ierr);CHKERRQ(ierr)
  3425) !  call VecRestoreArrayReadF90(X,X_p,ierr);CHKERRQ(ierr)
  3426) !
  3427) !end subroutine ToilImsCheckUpdatePre
  3428) !
  3429) !! ************************************************************************** !
  3430) 
  3431) 
  3432) ! ************************************************************************** !
  3433) 
  3434) function TOilImsAverageDensity(sat_up,sat_dn,density_up,density_dn)
  3435)   ! 
  3436)   ! Averages density, using opposite cell density if phase non-existent
  3437)   ! 
  3438)   ! Author: Paolo Orsini
  3439)   ! Date: 11/28/15
  3440)   ! 
  3441) 
  3442)   implicit none
  3443) 
  3444)   PetscReal :: sat_up, sat_dn
  3445)   PetscReal :: density_up, density_dn
  3446) 
  3447)   PetscReal :: TOilImsAverageDensity
  3448) 
  3449)   if (sat_up < eps ) then
  3450)     TOilImsAverageDensity = density_dn
  3451)   else if (sat_dn < eps ) then 
  3452)     TOilImsAverageDensity = density_up
  3453)   else ! in here we could use an armonic average, 
  3454)        ! other idea sat weighted average but it needs truncation
  3455)     TOilImsAverageDensity = 0.5d0*(density_up+density_dn)
  3456)   end if
  3457) 
  3458) end function TOilImsAverageDensity
  3459) 
  3460) ! ************************************************************************** !
  3461) 
  3462) 
  3463) end module TOilIms_module
  3464) 

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