characteristic_curves.F90       coverage:  56.69 %func     36.16 %block


     1) module Characteristic_Curves_module
     2)  
     3)   use PFLOTRAN_Constants_module
     4) 
     5)   implicit none
     6) 
     7)   private
     8) 
     9) #include "petsc/finclude/petscsys.h"
    10) 
    11)   PetscReal, parameter :: DEFAULT_PCMAX = 1.d9
    12)   
    13)   type :: polynomial_type
    14)     PetscReal :: low
    15)     PetscReal :: high
    16)     PetscReal :: coefficients(4)
    17)   end type polynomial_type
    18)  
    19)   ! Begin Saturation Functions ------------------------------------------------
    20)   type :: sat_func_base_type
    21)     type(polynomial_type), pointer :: sat_poly
    22)     type(polynomial_type), pointer :: pres_poly
    23)     PetscReal :: Sr
    24)     PetscReal :: pcmax
    25)   contains
    26)     procedure, public :: Init => SFBaseInit
    27)     procedure, public :: Verify => SFBaseVerify
    28)     procedure, public :: Test => SFBaseTest
    29)     procedure, public :: SetupPolynomials => SFBaseSetupPolynomials
    30)     procedure, public :: CapillaryPressure => SFBaseCapillaryPressure
    31)     procedure, public :: Saturation => SFBaseSaturation
    32)   end type sat_func_base_type
    33)   ! Default
    34)   type, public, extends(sat_func_base_type) :: sat_func_default_type
    35)   contains
    36)     procedure, public :: Verify => SFDefaultVerify
    37)     procedure, public :: CapillaryPressure => SFDefaultCapillaryPressure
    38)     procedure, public :: Saturation => SFDefaultSaturation
    39)   end type sat_func_default_type  
    40)   type, public, extends(sat_func_base_type) :: sat_func_VG_type
    41)     PetscReal :: alpha
    42)     PetscReal :: m
    43)   contains
    44)     procedure, public :: Init => SF_VG_Init
    45)     procedure, public :: Verify => SF_VG_Verify
    46)     procedure, public :: CapillaryPressure => SF_VG_CapillaryPressure
    47)     procedure, public :: Saturation => SF_VG_Saturation
    48)   end type sat_func_VG_type  
    49)   type, public, extends(sat_func_base_type) :: sat_func_BC_type
    50)     PetscReal :: alpha
    51)     PetscReal :: lambda
    52)   contains
    53)     procedure, public :: Init => SF_BC_Init
    54)     procedure, public :: Verify => SF_BC_Verify
    55)     procedure, public :: SetupPolynomials => SF_BC_SetupPolynomials
    56)     procedure, public :: CapillaryPressure => SF_BC_CapillaryPressure
    57)     procedure, public :: Saturation => SF_BC_Saturation
    58)   end type sat_func_BC_type  
    59)   type, public, extends(sat_func_base_type) :: sat_func_Linear_type
    60)     PetscReal :: alpha
    61)   contains
    62)     procedure, public :: Init => SF_Linear_Init
    63)     procedure, public :: Verify => SF_Linear_Verify
    64)     procedure, public :: CapillaryPressure => SF_Linear_CapillaryPressure
    65)     procedure, public :: Saturation => SF_Linear_Saturation
    66)   end type sat_func_Linear_type
    67)   ! BRAGFLO KRP9 modified Brooks-Corey Model
    68)   type, public, extends(sat_func_base_type) :: sat_func_BF_KRP9_type
    69)   contains
    70)     procedure, public :: Init => SF_BF_KRP9_Init
    71)     procedure, public :: Verify => SF_BF_KRP9_Verify
    72)     procedure, public :: CapillaryPressure => SF_BF_KRP9_CapillaryPressure
    73)     procedure, public :: Saturation => SF_BF_KRP9_Saturation
    74)   end type sat_func_BF_KRP9_type
    75)   ! BRAGFLO KRP4 modified Brooks-Corey Model
    76)   type, public, extends(sat_func_BC_type) :: sat_func_BF_KRP4_type
    77)     PetscReal :: Srg
    78)     PetscInt :: pcmax_flag
    79)   contains
    80)     procedure, public :: Verify => SF_BF_KRP4_Verify
    81)     procedure, public :: CapillaryPressure => SF_BF_KRP4_CapillaryPressure
    82)     procedure, public :: Saturation => SF_BF_KRP4_Saturation
    83)   end type sat_func_BF_KRP4_type
    84)   ! BRAGFLO KRP11 modified Brooks-Corey Model
    85)   type, public, extends(sat_func_base_type) :: sat_func_BF_KRP11_type
    86)   contains
    87)     procedure, public :: Init => SF_BF_KRP11_Init
    88)     procedure, public :: Verify => SF_BF_KRP11_Verify
    89)     procedure, public :: CapillaryPressure => SF_BF_KRP11_CapillaryPressure
    90)     procedure, public :: Saturation => SF_BF_KRP11_Saturation
    91)   end type sat_func_BF_KRP11_type 
    92)   ! BRAGFLO KRP12 modified Brooks-Corey Model
    93)   type, public, extends(sat_func_BC_type) :: sat_func_BF_KRP12_type
    94)     PetscReal :: Srg
    95)     PetscReal :: socmin
    96)     PetscReal :: soceffmin
    97)   contains
    98)     procedure, public :: Verify => SF_BF_KRP12_Verify
    99)     procedure, public :: CapillaryPressure => SF_BF_KRP12_CapillaryPressure
   100)   end type sat_func_BF_KRP12_type 
   101)   ! End Saturation Functions --------------------------------------------------
   102) 
   103)   ! Begin Relative Permeability Functions -------------------------------------
   104)   type :: rel_perm_func_base_type
   105)     type(polynomial_type), pointer :: poly
   106)     PetscReal :: Sr
   107)   contains
   108)     procedure, public :: Init => RPFBaseInit
   109)     procedure, public :: Verify => RPFBaseVerify
   110)     procedure, public :: Test => RPF_Base_Test
   111)     procedure, public :: SetupPolynomials => RPFBaseSetupPolynomials
   112)     procedure, public :: RelativePermeability => RPF_Base_RelPerm
   113)   end type rel_perm_func_base_type
   114)   ! Default
   115)   type, public, extends(rel_perm_func_base_type) :: rel_perm_func_default_type
   116)   contains
   117)     procedure, public :: Verify => RPFDefaultVerify
   118)     procedure, public :: RelativePermeability => RPF_DefaultRelPerm
   119)   end type rel_perm_func_default_type
   120)   ! Mualem-VG-liq
   121)   type, public, extends(rel_perm_func_base_type) :: rpf_Mualem_VG_liq_type
   122)     PetscReal :: m
   123)   contains
   124)     procedure, public :: Init => RPF_Mualem_VG_Liq_Init
   125)     procedure, public :: Verify => RPF_Mualem_VG_Liq_Verify
   126)     procedure, public :: SetupPolynomials => RPF_Mualem_SetupPolynomials
   127)     procedure, public :: RelativePermeability => RPF_Mualem_VG_Liq_RelPerm
   128)   end type rpf_Mualem_VG_liq_type
   129)   ! Mualem-VG-gas
   130)   type, public, extends(rel_perm_func_base_type) :: rpf_Mualem_VG_gas_type
   131)     PetscReal :: m
   132)     PetscReal :: Srg
   133)   contains
   134)     procedure, public :: Init => RPF_Mualem_VG_Gas_Init
   135)     procedure, public :: Verify => RPF_Mualem_VG_Gas_Verify
   136)     procedure, public :: RelativePermeability => RPF_Mualem_VG_Gas_RelPerm
   137)   end type rpf_Mualem_VG_gas_type
   138)   ! since the TOUGH2_Corey relative permeability function (IRP=7 in 
   139)   ! TOUGH2 manual) calculates relative perm as a function of the 
   140)   ! Mualem-based  liquid relative permeability when Srg = 0., we extend 
   141)   ! the rpf_Mualem_type to save code
   142)   type, public, extends(rpf_Mualem_VG_liq_type) :: rpf_TOUGH2_IRP7_gas_type
   143)     PetscReal :: Srg
   144)   contains
   145)     procedure, public :: Init => RPF_TOUGH2_IRP7_Gas_Init
   146)     procedure, public :: Verify => RPF_TOUGH2_IRP7_Gas_Verify
   147)     procedure, public :: RelativePermeability => RPF_TOUGH2_IRP7_Gas_RelPerm
   148)   end type rpf_TOUGH2_IRP7_gas_type
   149)   ! Burdine-BC
   150)   type, public, extends(rel_perm_func_base_type) :: rpf_Burdine_BC_liq_type
   151)     PetscReal :: lambda
   152)   contains
   153)     procedure, public :: Init => RPF_Burdine_BC_Liq_Init
   154)     procedure, public :: Verify => RPF_Burdine_BC_Liq_Verify
   155)     procedure, public :: RelativePermeability => RPF_Burdine_BC_Liq_RelPerm
   156)   end type rpf_Burdine_BC_liq_type
   157)   type, public, extends(rel_perm_func_base_type) :: rpf_Burdine_BC_gas_type
   158)     PetscReal :: lambda
   159)     PetscReal :: Srg
   160)   contains
   161)     procedure, public :: Init => RPF_Burdine_BC_Gas_Init
   162)     procedure, public :: Verify => RPF_Burdine_BC_Gas_Verify
   163)     procedure, public :: RelativePermeability => RPF_Burdine_BC_Gas_RelPerm
   164)   end type rpf_Burdine_BC_gas_type
   165)   ! Mualem-BC
   166)   type, public, extends(rel_perm_func_base_type) :: rpf_Mualem_BC_liq_type
   167)     PetscReal :: lambda
   168)   contains
   169)     procedure, public :: Init => RPF_Mualem_BC_Liq_Init
   170)     procedure, public :: Verify => RPF_Mualem_BC_Liq_Verify
   171)     procedure, public :: RelativePermeability => RPF_Mualem_BC_Liq_RelPerm
   172)   end type rpf_MUALEM_BC_liq_type
   173)   type, public, extends(rel_perm_func_base_type) :: rpf_Mualem_BC_gas_type
   174)     PetscReal :: lambda
   175)     PetscReal :: Srg
   176)   contains
   177)     procedure, public :: Init => RPF_Mualem_BC_Gas_Init
   178)     procedure, public :: Verify => RPF_Mualem_BC_Gas_Verify
   179)     procedure, public :: RelativePermeability => RPF_Mualem_BC_Gas_RelPerm
   180)   end type rpf_Mualem_BC_gas_type
   181)   ! Burdine-VG
   182)   type, public, extends(rel_perm_func_base_type) :: rpf_Burdine_VG_liq_type
   183)     PetscReal :: m
   184)   contains
   185)     procedure, public :: Init => RPF_Burdine_VG_Liq_Init
   186)     procedure, public :: Verify => RPF_Burdine_VG_Liq_Verify
   187)     procedure, public :: RelativePermeability => RPF_Burdine_VG_Liq_RelPerm
   188)   end type rpf_Burdine_VG_liq_type
   189)   type, public, extends(rel_perm_func_base_type) :: rpf_Burdine_VG_gas_type
   190)     PetscReal :: m
   191)     PetscReal :: Srg
   192)   contains
   193)     procedure, public :: Init => RPF_Burdine_VG_Gas_Init
   194)     procedure, public :: Verify => RPF_Burdine_VG_Gas_Verify
   195)     procedure, public :: RelativePermeability => RPF_Burdine_VG_Gas_RelPerm
   196)   end type rpf_Burdine_VG_gas_type
   197)   ! Mualem-Linear
   198)   type, public, extends(rel_perm_func_base_type) :: rpf_Mualem_Linear_liq_type
   199)     PetscReal :: pcmax
   200)     PetscReal :: alpha
   201)   contains
   202)     procedure, public :: Init => RPF_Mualem_Linear_Liq_Init
   203)     procedure, public :: Verify => RPF_Mualem_Linear_Liq_Verify
   204)     procedure, public :: RelativePermeability => RPF_Mualem_Linear_Liq_RelPerm
   205)   end type rpf_Mualem_Linear_liq_type
   206)   type, public, extends(rpf_Mualem_Linear_liq_type) :: & 
   207)                         rpf_Mualem_Linear_gas_type
   208)     PetscReal :: Srg
   209)   contains
   210)     procedure, public :: Init => RPF_Mualem_Linear_Gas_Init
   211)     procedure, public :: Verify => RPF_Mualem_Linear_Gas_Verify
   212)     procedure, public :: RelativePermeability => RPF_Mualem_Linear_Gas_RelPerm
   213)   end type rpf_Mualem_Linear_gas_type
   214)   ! Burdine-Linear
   215)   type, public, extends(rel_perm_func_base_type) :: rpf_Burdine_Linear_liq_type
   216)   contains
   217)     procedure, public :: Init => RPF_Burdine_Linear_Liq_Init
   218)     procedure, public :: Verify => RPF_Burdine_Linear_Liq_Verify
   219)     procedure, public :: RelativePermeability => RPF_Burdine_Linear_Liq_RelPerm
   220)   end type rpf_Burdine_Linear_liq_type
   221)   type, public, extends(rel_perm_func_base_type) :: & 
   222)                         rpf_Burdine_Linear_gas_type
   223)     PetscReal :: Srg
   224)   contains
   225)     procedure, public :: Init => RPF_Burdine_Linear_Gas_Init
   226)     procedure, public :: Verify => RPF_Burdine_Linear_Gas_Verify
   227)     procedure, public :: RelativePermeability => RPF_Burdine_Linear_Gas_RelPerm
   228)   end type rpf_Burdine_Linear_gas_type
   229)   ! BRAGFLO KRP9
   230)   type, public, extends(rel_perm_func_base_type) :: rpf_BRAGFLO_KRP9_liq_type
   231)   contains
   232)     procedure, public :: Init => RPF_BRAGFLO_KRP9_Liq_Init
   233)     procedure, public :: Verify => RPF_BRAGFLO_KRP9_Liq_Verify
   234)     procedure, public :: RelativePermeability => RPF_BRAGFLO_KRP9_Liq_RelPerm
   235)   end type rpf_BRAGFLO_KRP9_liq_type
   236)   type, public, extends(rpf_BRAGFLO_KRP9_liq_type) :: & 
   237)                         rpf_BRAGFLO_KRP9_gas_type
   238)     PetscReal :: Srg
   239)   contains
   240)     procedure, public :: Init => RPF_BRAGFLO_KRP9_Gas_Init
   241)     procedure, public :: Verify => RPF_BRAGFLO_KRP9_Gas_Verify
   242)     procedure, public :: RelativePermeability => RPF_BRAGFLO_KRP9_Gas_RelPerm
   243)   end type rpf_BRAGFLO_KRP9_gas_type
   244)   ! BRAGFLO KRP4 modified Brooks-Corey Model
   245)   ! relperm equations for KRP4 is identical to Burdine Brooks Corey
   246)   ! formulation, but with different conditions
   247)   type, public, extends(rpf_Burdine_BC_liq_type) :: rpf_BRAGFLO_KRP4_liq_type
   248)   contains
   249)   end type rpf_BRAGFLO_KRP4_liq_type
   250)   type, public, extends(rpf_Burdine_BC_gas_type) :: & 
   251)                         rpf_BRAGFLO_KRP4_gas_type
   252)   contains
   253)     procedure, public :: RelativePermeability => RPF_BRAGFLO_KRP4_Gas_RelPerm
   254)   end type rpf_BRAGFLO_KRP4_gas_type
   255)   ! BRAGFLO KRP11
   256)   type, public, extends(rel_perm_func_base_type) :: rpf_BRAGFLO_KRP11_liq_type
   257)     PetscReal :: tolc
   258)     PetscReal :: Srg
   259)   contains
   260)     procedure, public :: Init => RPF_BRAGFLO_KRP11_Liq_Init
   261)     procedure, public :: Verify => RPF_BRAGFLO_KRP11_Liq_Verify
   262)     procedure, public :: RelativePermeability => RPF_BRAGFLO_KRP11_Liq_RelPerm
   263)   end type rpf_BRAGFLO_KRP11_liq_type
   264)   type, public, extends(rpf_BRAGFLO_KRP11_liq_type) :: & 
   265)                         rpf_BRAGFLO_KRP11_gas_type
   266)   contains
   267)     procedure, public :: RelativePermeability => RPF_BRAGFLO_KRP11_Gas_RelPerm
   268)   end type rpf_BRAGFLO_KRP11_gas_type
   269)   ! BRAGFLO KRP12 modified Brooks-Corey Model
   270)   ! relperm equations for KRP12 is identical to Burdine Brooks Corey
   271)   ! formulation, but with different conditions and truncations
   272)   type, public, extends(rpf_Burdine_BC_liq_type) :: rpf_BRAGFLO_KRP12_liq_type
   273)   contains
   274)     procedure, public :: RelativePermeability => RPF_BRAGFLO_KRP12_Liq_RelPerm
   275)   end type rpf_BRAGFLO_KRP12_liq_type
   276)   type, public, extends(rpf_Burdine_BC_gas_type) :: rpf_BRAGFLO_KRP12_gas_type
   277)   contains
   278)     procedure, public :: RelativePermeability => RPF_BRAGFLO_KRP12_Gas_RelPerm
   279)   end type rpf_BRAGFLO_KRP12_gas_type
   280)   ! Oil relative permeability functions
   281)   type, public, extends(rel_perm_func_base_type) :: rpf_TOUGH2_Linear_oil_type
   282)     PetscReal :: Sro !
   283)   contains
   284)     procedure, public :: Init => RPF_TOUGH2_Linear_Oil_Init 
   285)     procedure, public :: Verify => RPF_TOUGH2_Linear_Oil_Verify
   286)     procedure, public :: RelativePermeability => RPF_TOUGH2_Linear_Oil_RelPerm
   287)   end type rpf_TOUGH2_Linear_Oil_type
   288)   type, public, extends(rel_perm_func_base_type) :: RPF_Mod_BC_type
   289)     PetscReal :: m   !exponential coeff. 
   290)     PetscReal :: Srg 
   291)     PetscReal :: Sro
   292)     PetscReal :: kr_max
   293)   contains
   294)     procedure, public :: Init => RPF_Mod_BC_Init 
   295)     procedure, public :: Verify => RPF_Mod_BC_Verify
   296)     procedure, public :: SetupPolynomials => RPF_Mod_BC_SetupPolynomials
   297)   end type RPF_Mod_BC_type
   298)   type, public, extends(RPF_Mod_BC_type) :: RPF_Mod_BC_liq_type
   299)   contains
   300)     procedure, public :: RelativePermeability => RPF_Mod_BC_Liq_RelPerm
   301)   end type RPF_Mod_BC_liq_type
   302)   type, public, extends(RPF_Mod_BC_type) :: RPF_Mod_BC_oil_type
   303)   contains
   304)     procedure, public :: RelativePermeability => RPF_Mod_BC_Oil_RelPerm
   305)   end type RPF_Mod_BC_oil_type
   306)   ! Constant: for running tests with a fixed relative permeability
   307)   type, public, extends(rel_perm_func_base_type) :: rel_perm_func_constant_type
   308)     PetscReal :: kr
   309)   contains
   310)     procedure, public :: Verify => RPFConstantVerify
   311)     procedure, public :: RelativePermeability => RPF_ConstantRelPerm
   312)   end type rel_perm_func_constant_type
   313)   ! End Relative Permeability Functions ---------------------------------------
   314)  
   315)   type, public :: characteristic_curves_type
   316)     character(len=MAXWORDLENGTH) :: name
   317)     PetscBool :: print_me
   318)     PetscBool :: test
   319)     class(sat_func_base_type), pointer :: saturation_function
   320)     class(rel_perm_func_base_type), pointer :: liq_rel_perm_function
   321)     class(rel_perm_func_base_type), pointer :: gas_rel_perm_function
   322)     class(rel_perm_func_base_type), pointer :: oil_rel_perm_function
   323)     class(characteristic_curves_type), pointer :: next
   324)   end type characteristic_curves_type
   325)   
   326)   type, public :: characteristic_curves_ptr_type
   327)     class(characteristic_curves_type), pointer :: ptr
   328)   end type characteristic_curves_ptr_type 
   329)   
   330)   public :: CharacteristicCurvesCreate, &
   331)             CharacteristicCurvesRead, &
   332)             CharacteristicCurvesAddToList, &
   333)             CharCurvesConvertListToArray, &
   334)             CharacteristicCurvesGetID, &
   335)             CharCurvesGetGetResidualSats, &
   336)             CharacteristicCurvesDestroy, &
   337)             CharCurvesInputRecord, &
   338)   ! required to be public for unit tests - Heeho Park
   339)             SF_VG_Create, &
   340)             SF_BC_Create, &
   341)             SF_Linear_Create, &
   342)             SF_BF_KRP9_Create, &
   343)             SF_BF_KRP4_Create, &
   344)             SF_BF_KRP11_Create, &
   345)             SF_BF_KRP12_Create, &
   346)             RPF_Mualem_VG_Liq_Create, &
   347)             RPF_Mualem_VG_Gas_Create, &
   348)             RPF_Burdine_BC_Liq_Create, &
   349)             RPF_Burdine_BC_Gas_Create, &
   350)             RPF_TOUGH2_IRP7_Gas_Create, &
   351)             RPF_Mualem_BC_Liq_Create, &
   352)             RPF_Mualem_BC_Gas_Create, &
   353)             RPF_Burdine_VG_Liq_Create, &
   354)             RPF_Burdine_VG_Gas_Create, &
   355)             RPF_Mualem_Linear_Liq_Create, &
   356)             RPF_Mualem_Linear_Gas_Create, &
   357)             RPF_Burdine_Linear_Liq_Create, &
   358)             RPF_Burdine_Linear_Gas_Create, &
   359)             RPF_BRAGFLO_KRP9_Liq_Create, &
   360)             RPF_BRAGFLO_KRP9_Gas_Create, &
   361)             RPF_BRAGFLO_KRP4_Liq_Create, &
   362)             RPF_BRAGFLO_KRP4_Gas_Create, &
   363)             RPF_BRAGFLO_KRP11_Liq_Create, &
   364)             RPF_BRAGFLO_KRP11_Gas_Create, &
   365)             RPF_BRAGFLO_KRP12_Liq_Create, &
   366)             RPF_BRAGFLO_KRP12_Gas_Create, &
   367)             PolynomialCreate
   368) 
   369) contains
   370) 
   371) ! ************************************************************************** !
   372) 
   373) ! Begin Characteristic Curves
   374) function CharacteristicCurvesCreate()
   375)   ! 
   376)   ! Creates a characteristic curve object that holds parameters and pointers
   377)   ! to functions for calculating saturation, capillary pressure, relative
   378)   ! permeability, etc.
   379)   ! 
   380)   ! Author: Glenn Hammond
   381)   ! Date: 09/23/14
   382)   ! 
   383) 
   384)   implicit none
   385) 
   386)   class(characteristic_curves_type), pointer :: CharacteristicCurvesCreate
   387)   
   388)   class(characteristic_curves_type), pointer :: characteristic_curves
   389)   
   390)   allocate(characteristic_curves)
   391)   characteristic_curves%name = ''
   392)   characteristic_curves%print_me = PETSC_FALSE
   393)   characteristic_curves%test = PETSC_FALSE
   394)   nullify(characteristic_curves%saturation_function)
   395)   nullify(characteristic_curves%liq_rel_perm_function)
   396)   nullify(characteristic_curves%gas_rel_perm_function)
   397)   nullify(characteristic_curves%oil_rel_perm_function)
   398)   nullify(characteristic_curves%next)
   399) 
   400)   CharacteristicCurvesCreate => characteristic_curves
   401) 
   402) end function CharacteristicCurvesCreate
   403) 
   404) ! ************************************************************************** !
   405) 
   406) subroutine CharacteristicCurvesRead(this,input,option)
   407)   ! 
   408)   ! Reads in contents of a saturation_function card
   409)   ! 
   410)   ! Author: Glenn Hammond
   411)   ! Date: 01/21/09
   412)   ! 
   413) 
   414)   use Option_module
   415)   use Input_Aux_module
   416)   use String_module
   417) 
   418)   implicit none
   419)   
   420)   class(characteristic_curves_type) :: this
   421)   type(input_type), pointer :: input
   422)   type(option_type) :: option
   423)   PetscInt :: iphase
   424)   
   425)   character(len=MAXWORDLENGTH) :: keyword, word, phase_keyword
   426)   character(len=MAXSTRINGLENGTH) :: error_string
   427)   class(rel_perm_func_base_type), pointer :: rel_perm_function_ptr
   428) 
   429)   input%ierr = 0
   430)   error_string = 'CHARACTERISTIC_CURVES'  
   431)   do
   432)   
   433)     call InputReadPflotranString(input,option)
   434) 
   435)     if (InputCheckExit(input,option)) exit  
   436) 
   437)     call InputReadWord(input,option,keyword,PETSC_TRUE)
   438)     call InputErrorMsg(input,option,'keyword',error_string)
   439)     call StringToUpper(keyword)   
   440)       
   441)     select case(trim(keyword))
   442)       case('SATURATION_FUNCTION')
   443) ! replacing read word that is capable of database lookup
   444) !        call InputReadWord(input,option,word,PETSC_TRUE)
   445)         call InputReadWordDbaseCompatible(input,option,word,PETSC_TRUE)
   446)         call InputErrorMsg(input,option,'saturation_function_type', &
   447)                            error_string)
   448)         call StringToUpper(word)
   449)         select case(word)
   450)           case('VAN_GENUCHTEN')
   451)             this%saturation_function => SF_VG_Create()
   452)           case('BROOKS_COREY')
   453)             this%saturation_function => SF_BC_Create()
   454)           case('LINEAR')
   455)             this%saturation_function => SF_Linear_Create()
   456)           case('BRAGFLO_KRP9')
   457)             this%saturation_function => SF_BF_KRP9_Create()
   458)           case('BRAGFLO_KRP4')
   459)             this%saturation_function => SF_BF_KRP4_Create()
   460)           case('BRAGFLO_KRP11')
   461)             this%saturation_function => SF_BF_KRP11_Create()
   462)           case('BRAGFLO_KRP12')
   463)             this%saturation_function => SF_BF_KRP12_Create()
   464)           case default
   465)             call InputKeywordUnrecognized(word,'SATURATION_FUNCTION',option)
   466)         end select
   467)         call SaturationFunctionRead(this%saturation_function,input,option)
   468)       case('PERMEABILITY_FUNCTION')
   469)         nullify(rel_perm_function_ptr)
   470)         phase_keyword = 'NONE'
   471) ! replacing read word that is capable of database lookup
   472) !        call InputReadWord(input,option,word,PETSC_TRUE)
   473)         call InputReadWordDbaseCompatible(input,option,word,PETSC_TRUE)
   474)         call InputErrorMsg(input,option,'permeability_function_type', &
   475)                            error_string)
   476)         call StringToUpper(word)
   477)         select case(word)
   478)           case('MUALEM','MUALEM_VG_LIQ')
   479)             rel_perm_function_ptr => RPF_Mualem_VG_Liq_Create()
   480)           case('MUALEM_VG_GAS')
   481)             rel_perm_function_ptr => RPF_Mualem_VG_Gas_Create()
   482)             phase_keyword = 'GAS'
   483)           case('BURDINE','BURDINE_BC_LIQ')
   484)             rel_perm_function_ptr => RPF_Burdine_BC_Liq_Create()
   485)           case('BURDINE_BC_GAS')
   486)             rel_perm_function_ptr => RPF_Burdine_BC_Gas_Create()
   487)             phase_keyword = 'GAS'
   488)           case('TOUGH2_IRP7_LIQ')
   489)             rel_perm_function_ptr => RPF_Mualem_VG_Liq_Create()
   490)           case('TOUGH2_IRP7_GAS')
   491)             rel_perm_function_ptr => RPF_TOUGH2_IRP7_Gas_Create()
   492)             phase_keyword = 'GAS'
   493)           case('MUALEM_BC_LIQ')
   494)             rel_perm_function_ptr => RPF_Mualem_BC_Liq_Create()
   495)           case('MUALEM_BC_GAS')
   496)             rel_perm_function_ptr => RPF_Mualem_BC_Gas_Create()
   497)             phase_keyword = 'GAS'
   498)           case('BURDINE_VG_LIQ')
   499)             rel_perm_function_ptr => RPF_Burdine_VG_Liq_Create()
   500)           case('BURDINE_VG_GAS')
   501)             rel_perm_function_ptr => RPF_Burdine_VG_Gas_Create()
   502)             phase_keyword = 'GAS'
   503)           case('MUALEM_LINEAR_LIQ')
   504)             rel_perm_function_ptr => RPF_Mualem_Linear_Liq_Create()
   505)           case('MUALEM_LINEAR_GAS')
   506)             rel_perm_function_ptr => RPF_Mualem_Linear_Gas_Create()
   507)             phase_keyword = 'GAS'
   508)           case('BURDINE_LINEAR_LIQ')
   509)             rel_perm_function_ptr => RPF_Burdine_Linear_Liq_Create()
   510)           case('BURDINE_LINEAR_GAS')
   511)             rel_perm_function_ptr => RPF_Burdine_Linear_Gas_Create()
   512)             phase_keyword = 'GAS'
   513)           case('BRAGFLO_KRP9_LIQ')
   514)             rel_perm_function_ptr => RPF_BRAGFLO_KRP9_Liq_Create()
   515)           case('BRAGFLO_KRP9_GAS')
   516)             rel_perm_function_ptr => RPF_BRAGFLO_KRP9_Gas_Create()
   517)           case('BRAGFLO_KRP4_LIQ')
   518)             rel_perm_function_ptr => RPF_BRAGFLO_KRP4_Liq_Create()
   519)           case('BRAGFLO_KRP4_GAS')
   520)             rel_perm_function_ptr => RPF_BRAGFLO_KRP4_Gas_Create()
   521)             phase_keyword = 'GAS'
   522)           case('BRAGFLO_KRP11_LIQ')
   523)             rel_perm_function_ptr => RPF_BRAGFLO_KRP11_Liq_Create()
   524)           case('BRAGFLO_KRP11_GAS')
   525)             rel_perm_function_ptr => RPF_BRAGFLO_KRP11_Gas_Create()
   526)             phase_keyword = 'GAS'
   527)           case('BRAGFLO_KRP12_LIQ')
   528)             rel_perm_function_ptr => RPF_BRAGFLO_KRP12_Liq_Create()
   529)           case('BRAGFLO_KRP12_GAS')
   530)             rel_perm_function_ptr => RPF_BRAGFLO_KRP12_Gas_Create()
   531)             phase_keyword = 'GAS'
   532)           case('TOUGH2_LINEAR_OIL')
   533)             rel_perm_function_ptr => RPF_TOUGH2_Linear_Oil_Create()
   534)             phase_keyword = 'OIL'
   535)           case('MOD_BC_LIQ')
   536)             rel_perm_function_ptr => RPF_Mod_BC_Liq_Create()
   537)             !phase_keyword = 'LIQUID'
   538)           case('MOD_BC_OIL')
   539)             rel_perm_function_ptr => RPF_Mod_BC_Oil_Create()
   540)             phase_keyword = 'OIL'
   541)           case('CONSTANT')
   542)             rel_perm_function_ptr => RPF_Constant_Create()
   543)           case default
   544)             call InputKeywordUnrecognized(word,'PERMEABILITY_FUNCTION',option)
   545)         end select
   546)         call PermeabilityFunctionRead(rel_perm_function_ptr,phase_keyword, &
   547)                                       input,option)
   548)         ! if PHASE is specified, have to align correct pointer
   549)         select case(phase_keyword)
   550)           case('GAS')
   551)             this%gas_rel_perm_function => rel_perm_function_ptr
   552)           case('LIQUID')
   553)             this%liq_rel_perm_function => rel_perm_function_ptr
   554)           case('OIL')
   555)             this%oil_rel_perm_function => rel_perm_function_ptr 
   556)             ! PO: gas_rel_perm_fucntion initiated oil_rel_perm_function
   557)             ! to pass the verification in CharacteristicCurvesVerify
   558)             ! in case gas_rel_perm_function is not defined in the input
   559)             ! We should change CharacteristicCurvesVerify instead
   560)              this%gas_rel_perm_function => rel_perm_function_ptr
   561)           case('NONE')
   562)             this%gas_rel_perm_function => rel_perm_function_ptr
   563)             this%liq_rel_perm_function => rel_perm_function_ptr
   564)           case default
   565)             call InputKeywordUnrecognized(word, &
   566)               'PERMEABILITY_FUNCTION,PHASE',option)
   567)         end select
   568)       case('TEST') 
   569)         this%test = PETSC_TRUE
   570)       case('DEFAULT')
   571)         this%saturation_function => SF_Default_Create()
   572)         this%liq_rel_perm_function => RPF_Default_Create()
   573)         this%gas_rel_perm_function => this%liq_rel_perm_function
   574)       case default
   575)         call InputKeywordUnrecognized(keyword,'charateristic_curves',option)
   576)     end select 
   577)   enddo
   578)   
   579)   call CharacteristicCurvesVerify(this,option)
   580) 
   581) end subroutine CharacteristicCurvesRead
   582) 
   583) ! ************************************************************************** !
   584) 
   585) subroutine SaturationFunctionRead(saturation_function,input,option)
   586)   !
   587)   ! Reads in contents of a SATURATION_FUNCTION block
   588)   !
   589)   use Option_module
   590)   use Input_Aux_module
   591)   use String_module
   592) 
   593)   implicit none
   594)   
   595)   class(sat_func_base_type) :: saturation_function
   596)   type(input_type), pointer :: input
   597)   type(option_type) :: option
   598)   
   599)   character(len=MAXWORDLENGTH) :: keyword
   600)   character(len=MAXSTRINGLENGTH) :: error_string
   601)   PetscBool :: found
   602)   PetscBool :: smooth
   603) 
   604)   input%ierr = 0
   605)   smooth = PETSC_FALSE
   606)   error_string = 'CHARACTERISTIC_CURVES,SATURATION_FUNCTION,'
   607)   select type(sf => saturation_function)
   608)     class is(sat_func_VG_type)
   609)       error_string = trim(error_string) // 'VAN_GENUCHTEN'
   610)     class is(sat_func_BC_type)
   611)       error_string = trim(error_string) // 'BROOKS_COREY'
   612)     class is(sat_func_Linear_type)
   613)       error_string = trim(error_string) // 'LINEAR'
   614)   end select
   615)   do
   616)     call InputReadPflotranString(input,option)
   617)     if (InputCheckExit(input,option)) exit  
   618) 
   619)     call InputReadWord(input,option,keyword,PETSC_TRUE)
   620)     call InputErrorMsg(input,option,'keyword',error_string)
   621)     call StringToUpper(keyword)   
   622) 
   623)     ! base 
   624)     found = PETSC_TRUE
   625)     select case(keyword)
   626)       case('LIQUID_RESIDUAL_SATURATION') 
   627)         call InputReadDouble(input,option,saturation_function%Sr)
   628)         call InputErrorMsg(input,option,'liquid residual saturation', &
   629)                            error_string)
   630)       case('MAX_CAPILLARY_PRESSURE') 
   631)         call InputReadDouble(input,option,saturation_function%pcmax)
   632)         call InputErrorMsg(input,option,'maximum capillary pressure', &
   633)                             error_string)
   634)       case('SMOOTH')
   635)         smooth = PETSC_TRUE
   636)       case default
   637)         found = PETSC_FALSE
   638)     end select
   639)     
   640)     if (found) cycle
   641)     
   642)     select type(sf => saturation_function)
   643)       class is(sat_func_VG_type)
   644)         select case(keyword)
   645)           case('M') 
   646)             call InputReadDouble(input,option,sf%m)
   647)             call InputErrorMsg(input,option,'m',error_string)
   648)           case('ALPHA') 
   649)             call InputReadDouble(input,option,sf%alpha)
   650)             call InputErrorMsg(input,option,'alpha',error_string)
   651)           case default
   652)             call InputKeywordUnrecognized(keyword, &
   653)                    'van Genuchten saturation function',option)
   654)         end select
   655)       class is(sat_func_BC_type)
   656)         select case(keyword)
   657)           case('LAMBDA') 
   658)             call InputReadDouble(input,option,sf%lambda)
   659)             call InputErrorMsg(input,option,'lambda',error_string)
   660)           case('ALPHA') 
   661)             call InputReadDouble(input,option,sf%alpha)
   662)             call InputErrorMsg(input,option,'alpha',error_string)
   663)           case default
   664)             call InputKeywordUnrecognized(keyword, &
   665)                    'Brooks-Corey saturation function',option)
   666)         end select
   667)       class is(sat_func_Linear_type)
   668)         select case(keyword)
   669)           case('ALPHA')
   670)             call InputReadDouble(input,option,sf%alpha)
   671)             call InputErrorMsg(input,option,'alpha',error_string)
   672)           case default
   673)             call InputKeywordUnrecognized(keyword, &
   674)                    'Linear saturation function',option)
   675)         end select
   676)       class is(sat_func_BF_KRP4_type)
   677)         select case(keyword)
   678)           case('LAMBDA') 
   679)             call InputReadDouble(input,option,sf%lambda)
   680)             call InputErrorMsg(input,option,'lambda',error_string)
   681)           case('ALPHA') 
   682)             call InputReadDouble(input,option,sf%alpha)
   683)             call InputErrorMsg(input,option,'alpha',error_string)
   684)           case('GAS_RESIDUAL_SATURATION') 
   685)             call InputReadDouble(input,option,sf%Srg)
   686)             call InputErrorMsg(input,option,'Srg',error_string)
   687)           case('KPC') 
   688)             call InputReadInt(input,option,sf%pcmax_flag)
   689)             call InputErrorMsg(input,option,'pcmax_flag',error_string)
   690)           case default
   691)             call InputKeywordUnrecognized(keyword, &
   692)                    'Brooks-Corey saturation function',option)
   693)         end select
   694)       class is(sat_func_BF_KRP12_type)
   695)         select case(keyword)
   696)           case('LAMBDA') 
   697)             call InputReadDouble(input,option,sf%lambda)
   698)             call InputErrorMsg(input,option,'lambda',error_string)
   699)           case('ALPHA') 
   700)             call InputReadDouble(input,option,sf%alpha)
   701)             call InputErrorMsg(input,option,'alpha',error_string)
   702)           case('GAS_RESIDUAL_SATURATION') 
   703)             call InputReadDouble(input,option,sf%Srg)
   704)             call InputErrorMsg(input,option,'Srg',error_string)
   705)           case('SOCMIN') 
   706)             call InputReadDouble(input,option,sf%socmin)
   707)             call InputErrorMsg(input,option,'socmin',error_string)
   708)           case('SOCEFFMIN') 
   709)             call InputReadDouble(input,option,sf%soceffmin)
   710)             call InputErrorMsg(input,option,'soceffmin',error_string)
   711)           case default
   712)             call InputKeywordUnrecognized(keyword, &
   713)                    'Brooks-Corey saturation function',option)
   714)         end select
   715)       class default
   716)         option%io_buffer = 'Read routine not implemented for saturation ' // &
   717)                            'function class.'
   718)         call printErrMsg(option)
   719)     end select
   720)   enddo
   721)   
   722)   if (smooth) then
   723)     call saturation_function%SetupPolynomials(option,error_string)
   724)   endif
   725) 
   726)   select type(sf => saturation_function)
   727)     class is(sat_func_VG_type)
   728)     class is(sat_func_BC_type)
   729)       if (.not.smooth) then
   730)         option%io_buffer = 'Brooks-Corey saturation function is being used ' // &
   731)           'without SMOOTH option.'
   732)         call printWrnMsg(option)
   733)       endif
   734)     class is(sat_func_Linear_type)
   735)     class is(sat_func_BF_KRP4_type)
   736)       if (.not.smooth) then
   737)         option%io_buffer = 'Brooks-Corey saturation function is being used ' // &
   738)           'without SMOOTH option.'
   739)         call printWrnMsg(option)
   740)       endif
   741)     class is(sat_func_BF_KRP12_type)
   742)       if (.not.smooth) then
   743)         option%io_buffer = 'Brooks-Corey saturation function is being used ' // &
   744)           'without SMOOTH option.'
   745)         call printWrnMsg(option)
   746)       endif
   747)   end select
   748) 
   749) end subroutine SaturationFunctionRead
   750) 
   751) ! ************************************************************************** !
   752) 
   753) subroutine PermeabilityFunctionRead(permeability_function,phase_keyword, &
   754)                                     input,option)
   755)   !
   756)   ! Reads in contents of a PERMEABILITY_FUNCTION block
   757)   !
   758)   use Option_module
   759)   use Input_Aux_module
   760)   use String_module
   761) 
   762)   implicit none
   763)   
   764)   class(rel_perm_func_base_type) :: permeability_function
   765)   character(len=MAXWORDLENGTH) :: phase_keyword
   766)   type(input_type), pointer :: input
   767)   type(option_type) :: option
   768)   
   769)   character(len=MAXWORDLENGTH) :: keyword, new_phase_keyword
   770)   character(len=MAXSTRINGLENGTH) :: error_string
   771)   PetscBool :: found
   772)   PetscBool :: smooth
   773) 
   774)   input%ierr = 0
   775)   smooth = PETSC_FALSE
   776)   new_phase_keyword = 'NONE'
   777)   error_string = 'CHARACTERISTIC_CURVES,PERMEABILITY_FUNCTION,'
   778)   select type(rpf => permeability_function)
   779)     class is(rpf_Mualem_VG_liq_type)
   780)       error_string = trim(error_string) // 'MUALEM_VG_LIQ'
   781)     class is(rpf_Mualem_VG_gas_type)
   782)       error_string = trim(error_string) // 'MUALEM_VG_GAS'
   783)     class is(rpf_Burdine_BC_liq_type)
   784)       error_string = trim(error_string) // 'BURDINE_BC_LIQ'
   785)     class is(rpf_Burdine_BC_gas_type)
   786)       error_string = trim(error_string) // 'BURDINE_BC_GAS'
   787)     class is(rpf_TOUGH2_IRP7_gas_type)
   788)       error_string = trim(error_string) // 'TOUGH2_IRP7_GAS'
   789)     class is(rpf_Mualem_BC_liq_type)
   790)       error_string = trim(error_string) // 'MUALEM_BC_LIQ'
   791)     class is(rpf_Mualem_BC_gas_type)
   792)       error_string = trim(error_string) // 'MUALEM_BC_GAS'
   793)     class is(rpf_Burdine_VG_liq_type)
   794)       error_string = trim(error_string) // 'BURDINE_VG_LIQ'
   795)     class is(rpf_Burdine_VG_gas_type)
   796)       error_string = trim(error_string) // 'BURDINE_VG_GAS'
   797)     class is(rpf_Mualem_Linear_liq_type)
   798)       error_string = trim(error_string) // 'MUALEM_Linear_LIQ'
   799)     class is(rpf_Mualem_Linear_gas_type)
   800)       error_string = trim(error_string) // 'MUALEM_Linear_GAS'
   801)     class is(rpf_Burdine_Linear_liq_type)
   802)       error_string = trim(error_string) // 'BURDINE_Linear_LIQ'
   803)     class is(rpf_Burdine_Linear_gas_type)
   804)       error_string = trim(error_string) // 'BURDINE_Linear_GAS'
   805)     class is(rpf_BRAGFLO_KRP9_liq_type)
   806)       error_string = trim(error_string) // 'BURDINE_BF_KRP9_LIQ'
   807)     class is(rpf_BRAGFLO_KRP9_gas_type)
   808)       error_string = trim(error_string) // 'BURDINE_BF_KRP9_GAS'
   809)     class is(rpf_BRAGFLO_KRP4_liq_type)
   810)       error_string = trim(error_string) // 'BURDINE_BF_KRP4_LIQ'
   811)     class is(rpf_BRAGFLO_KRP4_gas_type)
   812)       error_string = trim(error_string) // 'BURDINE_BF_KRP4_GAS'  
   813)     class is(rpf_BRAGFLO_KRP11_liq_type)
   814)       error_string = trim(error_string) // 'BURDINE_BF_KRP11_LIQ'
   815)     class is(rpf_BRAGFLO_KRP11_gas_type)
   816)       error_string = trim(error_string) // 'BURDINE_BF_KRP11_GAS'
   817)     class is(rpf_BRAGFLO_KRP12_liq_type)
   818)       error_string = trim(error_string) // 'BURDINE_BF_KRP12_LIQ'
   819)     class is(rpf_BRAGFLO_KRP12_gas_type)
   820)       error_string = trim(error_string) // 'BURDINE_BF_KRP12_GAS'
   821)     class is(rpf_TOUGH2_Linear_oil_type)
   822)       error_string = trim(error_string) // 'TOUGH2_Linear_OIL'
   823)     class is(rpf_mod_BC_liq_type)
   824)       error_string = trim(error_string) // 'Mod_BC_LIQ'
   825)     class is(rpf_mod_BC_oil_type)
   826)       error_string = trim(error_string) // 'Mod_BC_OIL'
   827)     class is(rel_perm_func_constant_type)
   828)       error_string = trim(error_string) // 'CONSTANT'
   829)   end select
   830) 
   831)   do
   832)     call InputReadPflotranString(input,option)
   833)     if (InputCheckExit(input,option)) exit  
   834) 
   835)     call InputReadWord(input,option,keyword,PETSC_TRUE)
   836)     call InputErrorMsg(input,option,'keyword',error_string)
   837)     call StringToUpper(keyword)   
   838) 
   839)     ! base 
   840)     found = PETSC_TRUE
   841)     select case(keyword)
   842)       case('LIQUID_RESIDUAL_SATURATION') 
   843)         call InputReadDouble(input,option,permeability_function%Sr)
   844)         call InputErrorMsg(input,option,'residual_saturation',error_string)
   845)       case('PHASE')
   846)         call InputReadWord(input,option,new_phase_keyword,PETSC_TRUE)
   847)         call InputErrorMsg(input,option,'phase',error_string)
   848)         call StringToUpper(phase_keyword) 
   849)       case('SMOOTH')
   850)         smooth = PETSC_TRUE
   851)       case default
   852)         found = PETSC_FALSE
   853)     end select
   854)     
   855)     if (found) cycle
   856)     
   857)     ! we assume liquid phase if PHASE keyword is not present.
   858)     select type(rpf => permeability_function)
   859)       class is(rpf_Mualem_VG_liq_type)
   860)         select case(keyword)
   861)           case('M') 
   862)             call InputReadDouble(input,option,rpf%m)
   863)             call InputErrorMsg(input,option,'m',error_string)
   864)           case default
   865)             call InputKeywordUnrecognized(keyword, &
   866)               'Mualem van Genuchten liquid relative permeability function', &
   867)               option)
   868)         end select
   869)       class is(rpf_Mualem_VG_gas_type)
   870)         select case(keyword)
   871)           case('M') 
   872)             call InputReadDouble(input,option,rpf%m)
   873)             call InputErrorMsg(input,option,'m',error_string)
   874)           case('GAS_RESIDUAL_SATURATION') 
   875)             call InputReadDouble(input,option,rpf%Srg)
   876)             call InputErrorMsg(input,option,'Srg',error_string)
   877)           case default
   878)             call InputKeywordUnrecognized(keyword, &
   879)               'Mualem van Genuchten gas relative permeability function', &
   880)               option)
   881)         end select
   882)       class is(rpf_Burdine_BC_liq_type)
   883)         select case(keyword)
   884)           case('LAMBDA') 
   885)             call InputReadDouble(input,option,rpf%lambda)
   886)             call InputErrorMsg(input,option,'lambda',error_string)
   887)           case default
   888)             call InputKeywordUnrecognized(keyword, &
   889)               'Burdine Brooks-Corey liquid relative permeability function', &
   890)               option)
   891)         end select
   892)       class is(rpf_Burdine_BC_gas_type)
   893)         select case(keyword)
   894)           case('LAMBDA') 
   895)             call InputReadDouble(input,option,rpf%lambda)
   896)             call InputErrorMsg(input,option,'lambda',error_string)
   897)           case('GAS_RESIDUAL_SATURATION') 
   898)             call InputReadDouble(input,option,rpf%Srg)
   899)             call InputErrorMsg(input,option,'Srg',error_string)
   900)           case default
   901)             call InputKeywordUnrecognized(keyword, &
   902)               'Burdine Brooks-Corey gas relative permeability function', &
   903)               option)
   904)         end select
   905)       class is(rpf_TOUGH2_IRP7_gas_type)
   906)         select case(keyword)
   907)           case('M') 
   908)             call InputReadDouble(input,option,rpf%m)
   909)             call InputErrorMsg(input,option,'m',error_string)
   910)           case('GAS_RESIDUAL_SATURATION') 
   911)             call InputReadDouble(input,option,rpf%Srg)
   912)             call InputErrorMsg(input,option,'Srg',error_string)
   913)           case default
   914)             call InputKeywordUnrecognized(keyword, &
   915)                    'TOUGH2 IRP7 gas relative permeability function',option)
   916)         end select
   917)       class is(rpf_Mualem_BC_liq_type)
   918)         select case(keyword)
   919)           case('LAMBDA') 
   920)             call InputReadDouble(input,option,rpf%lambda)
   921)             call InputErrorMsg(input,option,'lambda',error_string)
   922)           case default
   923)             call InputKeywordUnrecognized(keyword, &
   924)               'Mualem Brooks-Corey liquid relative permeability function', &
   925)               option)
   926)         end select
   927)       class is(rpf_Mualem_BC_gas_type)
   928)         select case(keyword)
   929)           case('LAMBDA') 
   930)             call InputReadDouble(input,option,rpf%lambda)
   931)             call InputErrorMsg(input,option,'lambda',error_string)
   932)           case('GAS_RESIDUAL_SATURATION') 
   933)             call InputReadDouble(input,option,rpf%Srg)
   934)             call InputErrorMsg(input,option,'Srg',error_string)
   935)           case default
   936)             call InputKeywordUnrecognized(keyword, &
   937)               'Mualem Brooks-Corey gas relative permeability function', &
   938)               option)
   939)         end select
   940)       class is(rpf_Burdine_VG_liq_type)
   941)         select case(keyword)
   942)           case('M') 
   943)             call InputReadDouble(input,option,rpf%m)
   944)             call InputErrorMsg(input,option,'m',error_string)
   945)           case default
   946)             call InputKeywordUnrecognized(keyword, &
   947)               'Burdine van Genuchten liquid relative permeability function', &
   948)               option)
   949)         end select
   950)       class is(rpf_Burdine_VG_gas_type)
   951)         select case(keyword)
   952)           case('M') 
   953)             call InputReadDouble(input,option,rpf%m)
   954)             call InputErrorMsg(input,option,'m',error_string)
   955)           case('GAS_RESIDUAL_SATURATION') 
   956)             call InputReadDouble(input,option,rpf%Srg)
   957)             call InputErrorMsg(input,option,'Srg',error_string)
   958)           case default
   959)             call InputKeywordUnrecognized(keyword, &
   960)               'Burdine van Genuchten gas relative permeability function', &
   961)               option)
   962)         end select
   963)       class is(rpf_Mualem_Linear_liq_type)
   964)         select case(keyword)
   965)           case('MAX_CAPILLARY_PRESSURE') 
   966)             call InputReadDouble(input,option,rpf%pcmax)
   967)             call InputErrorMsg(input,option,'max_capillary_pressure',error_string)
   968)           case('ALPHA') 
   969)             call InputReadDouble(input,option,rpf%alpha)
   970)             call InputErrorMsg(input,option,'alpha',error_string)
   971)           case default
   972)             call InputKeywordUnrecognized(keyword, &
   973)               'Mualem Linear liquid relative permeability function', &
   974)               option)
   975)         end select
   976)       class is(rpf_Mualem_Linear_gas_type)
   977)         select case(keyword)
   978)           case('GAS_RESIDUAL_SATURATION') 
   979)             call InputReadDouble(input,option,rpf%Srg)
   980)             call InputErrorMsg(input,option,'Srg',error_string)
   981)           case('MAX_CAPILLARY_PRESSURE') 
   982)             call InputReadDouble(input,option,rpf%pcmax)
   983)             call InputErrorMsg(input,option,'max_capillary_pressure',error_string)
   984)           case('ALPHA') 
   985)             call InputReadDouble(input,option,rpf%alpha)
   986)             call InputErrorMsg(input,option,'alpha',error_string)
   987)           case default
   988)             call InputKeywordUnrecognized(keyword, &
   989)               'Mualem Linear gas relative permeability function', &
   990)               option)
   991)         end select
   992)       class is(rpf_Burdine_Linear_liq_type)
   993)         select case(keyword)
   994)           case default
   995)             call InputKeywordUnrecognized(keyword, &
   996)               'Burdine Linear liquid relative permeability function', &
   997)               option)
   998)         end select
   999)       class is(rpf_Burdine_Linear_gas_type)
  1000)         select case(keyword)
  1001)           case('GAS_RESIDUAL_SATURATION') 
  1002)             call InputReadDouble(input,option,rpf%Srg)
  1003)             call InputErrorMsg(input,option,'Srg',error_string)
  1004)           case default
  1005)             call InputKeywordUnrecognized(keyword, &
  1006)               'Burdine Linear gas relative permeability function', &
  1007)               option)
  1008)         end select
  1009)       class is(rpf_BRAGFLO_KRP9_liq_type)
  1010)         select case(keyword)
  1011)           case default
  1012)             call InputKeywordUnrecognized(keyword, &
  1013)               'BRAGFLO KRP9 liq relative permeability function', &
  1014)               option)
  1015)         end select
  1016)       class is(rpf_BRAGFLO_KRP9_gas_type)
  1017)         select case(keyword)
  1018)           case('GAS_RESIDUAL_SATURATION') 
  1019)             call InputReadDouble(input,option,rpf%Srg)
  1020)             call InputErrorMsg(input,option,'Srg',error_string)
  1021)           case default
  1022)             call InputKeywordUnrecognized(keyword, &
  1023)               'BRAGFLO KRP9 gas relative permeability function', &
  1024)               option)
  1025)         end select
  1026)       class is(rpf_BRAGFLO_KRP4_liq_type)
  1027)         select case(keyword)
  1028)           case('LAMBDA') 
  1029)             call InputReadDouble(input,option,rpf%lambda)
  1030)             call InputErrorMsg(input,option,'lambda',error_string)
  1031)           case default
  1032)             call InputKeywordUnrecognized(keyword, &
  1033)               'BRAGFLO KRP4 liq relative permeability function', &
  1034)               option)
  1035)         end select
  1036)       class is(rpf_BRAGFLO_KRP4_gas_type)
  1037)         select case(keyword)
  1038)           case('LAMBDA') 
  1039)             call InputReadDouble(input,option,rpf%lambda)
  1040)             call InputErrorMsg(input,option,'lambda',error_string)
  1041)           case('GAS_RESIDUAL_SATURATION') 
  1042)             call InputReadDouble(input,option,rpf%Srg)
  1043)             call InputErrorMsg(input,option,'Srg',error_string)
  1044)           case default
  1045)             call InputKeywordUnrecognized(keyword, &
  1046)               'BRAGFLO KRP4 gas relative permeability function', &
  1047)               option)
  1048)         end select
  1049)       class is(rpf_BRAGFLO_KRP11_liq_type)
  1050)         select case(keyword)
  1051)           case('TOLC') 
  1052)             call InputReadDouble(input,option,rpf%tolc)
  1053)             call InputErrorMsg(input,option,'tolc',error_string)
  1054)           case default
  1055)             call InputKeywordUnrecognized(keyword, &
  1056)               'BRAGFLO KRP11 liq relative permeability function', &
  1057)               option)
  1058)         end select
  1059)       class is(rpf_BRAGFLO_KRP11_gas_type)
  1060)         select case(keyword)
  1061)           case('TOLC') 
  1062)             call InputReadDouble(input,option,rpf%tolc)
  1063)             call InputErrorMsg(input,option,'tolc',error_string)
  1064)           case('GAS_RESIDUAL_SATURATION') 
  1065)             call InputReadDouble(input,option,rpf%Srg)
  1066)             call InputErrorMsg(input,option,'Srg',error_string)
  1067)           case default
  1068)             call InputKeywordUnrecognized(keyword, &
  1069)               'BRAGFLO KRP11 gas relative permeability function', &
  1070)               option)
  1071)         end select  
  1072)       class is(rpf_BRAGFLO_KRP12_liq_type)
  1073)         select case(keyword)
  1074)           case('LAMBDA') 
  1075)             call InputReadDouble(input,option,rpf%lambda)
  1076)             call InputErrorMsg(input,option,'lambda',error_string)
  1077)           case default
  1078)             call InputKeywordUnrecognized(keyword, &
  1079)               'BRAGFLO KRP4 liq relative permeability function', &
  1080)               option)
  1081)         end select
  1082)       class is(rpf_BRAGFLO_KRP12_gas_type)
  1083)         select case(keyword)
  1084)           case('LAMBDA') 
  1085)             call InputReadDouble(input,option,rpf%lambda)
  1086)             call InputErrorMsg(input,option,'lambda',error_string)
  1087)           case('GAS_RESIDUAL_SATURATION') 
  1088)             call InputReadDouble(input,option,rpf%Srg)
  1089)             call InputErrorMsg(input,option,'Srg',error_string)
  1090)           case default
  1091)             call InputKeywordUnrecognized(keyword, &
  1092)               'BRAGFLO KRP4 gas relative permeability function', &
  1093)               option)
  1094)         end select
  1095)       class is(rpf_TOUGH2_Linear_oil_type)
  1096)         select case(keyword)
  1097)           case('OIL_RESIDUAL_SATURATION') 
  1098)             call InputReadDouble(input,option,rpf%Sro)
  1099)             call InputErrorMsg(input,option,'Sro',error_string)
  1100)           case default
  1101)             call InputKeywordUnrecognized(keyword, &
  1102)               'TOUGH2 LINEAR oil relative permeability function', &
  1103)               option)
  1104)         end select
  1105)       class is(rpf_mod_BC_liq_type)
  1106)         select case(keyword)
  1107)           case('M')
  1108)             call InputReadDouble(input,option,rpf%m)
  1109)             call InputErrorMsg(input,option,'m - power',error_string)
  1110)           case('OIL_RESIDUAL_SATURATION') 
  1111)             call InputReadDouble(input,option,rpf%Sro)
  1112)             call InputErrorMsg(input,option,'Sro',error_string)
  1113)           case('GAS_RESIDUAL_SATURATION') 
  1114)             call InputReadDouble(input,option,rpf%Srg)
  1115)             call InputErrorMsg(input,option,'Srg',error_string)
  1116)           case('LIQUID_MAX_REL_PERM') 
  1117)             call InputReadDouble(input,option,rpf%kr_max)
  1118)             call InputErrorMsg(input,option,'kr_max',error_string)
  1119)           case default
  1120)             call InputKeywordUnrecognized(keyword, &
  1121)               'Mod BC liq relative permeability function', &
  1122)               option)
  1123)         end select
  1124)       class is(rpf_mod_BC_oil_type)
  1125)         select case(keyword)
  1126)           case('M')
  1127)             call InputReadDouble(input,option,rpf%m)
  1128)             call InputErrorMsg(input,option,'m - power',error_string)
  1129)           case('OIL_RESIDUAL_SATURATION') 
  1130)             call InputReadDouble(input,option,rpf%Sro)
  1131)             call InputErrorMsg(input,option,'Sro',error_string)
  1132)           case('GAS_RESIDUAL_SATURATION') 
  1133)             call InputReadDouble(input,option,rpf%Srg)
  1134)             call InputErrorMsg(input,option,'Srg',error_string)
  1135)           case('OIL_MAX_REL_PERM') 
  1136)             call InputReadDouble(input,option,rpf%kr_max)
  1137)             call InputErrorMsg(input,option,'kr_max',error_string)
  1138)           case default
  1139)             call InputKeywordUnrecognized(keyword, &
  1140)               'Mod BC oil relative permeability function', &
  1141)               option)
  1142)         end select
  1143)       class is(rel_perm_func_constant_type)
  1144)         select case(keyword)
  1145)           case('RESIDUAL_SATURATION')
  1146)             call InputReadDouble(input,option,rpf%Sr)
  1147)             call InputErrorMsg(input,option,'Sr',error_string)
  1148)           case('RELATIVE_PERMEABILITY') 
  1149)             call InputReadDouble(input,option,rpf%kr)
  1150)             call InputErrorMsg(input,option,'kr',error_string)
  1151)           case default
  1152)             call InputKeywordUnrecognized(keyword, &
  1153)               'Constant relative permeability function', &
  1154)               option)
  1155)         end select
  1156)       class default
  1157)         option%io_buffer = 'Read routine not implemented for relative ' // &
  1158)                            'permeability function class.'
  1159)         call printErrMsg(option)
  1160)     end select
  1161)   enddo
  1162)   
  1163)   ! check to ensure that the phase is correct if phase_keyword was set to 
  1164)   ! something other than 'NONE' prior to the call of this subroutine
  1165)   if (StringCompare('NONE',phase_keyword)) then
  1166)     phase_keyword = new_phase_keyword
  1167)   else if (.not.StringCompare('NONE',new_phase_keyword)) then
  1168)     if (.not.StringCompare(phase_keyword,new_phase_keyword)) then
  1169)       option%io_buffer = 'Relative permeability function has been set ' // &
  1170)         'for the wrong phase (' // trim(phase_keyword) // ' vs ' // &
  1171)         trim(new_phase_keyword) // ').'
  1172)       call printErrMsg(option)
  1173)     endif
  1174)   endif
  1175) 
  1176)   if (smooth) then
  1177)     call permeability_function%SetupPolynomials(option,error_string)
  1178)   endif
  1179)   
  1180) end subroutine PermeabilityFunctionRead
  1181) 
  1182) ! ************************************************************************** !
  1183) 
  1184) subroutine CharacteristicCurvesAddToList(new_characteristic_curves,list)
  1185)   ! 
  1186)   ! Adds a characteristic curves object to linked list
  1187)   ! 
  1188)   ! Author: Glenn Hammond
  1189)   ! Date: 11/02/07
  1190)   ! 
  1191) 
  1192)   implicit none
  1193)   
  1194)   class(characteristic_curves_type), pointer :: new_characteristic_curves
  1195)   class(characteristic_curves_type), pointer :: list
  1196) 
  1197)   class(characteristic_curves_type), pointer :: cur_characteristic_curves
  1198)   
  1199)   if (associated(list)) then
  1200)     cur_characteristic_curves => list
  1201)     ! loop to end of list
  1202)     do
  1203)       if (.not.associated(cur_characteristic_curves%next)) exit
  1204)       cur_characteristic_curves => cur_characteristic_curves%next
  1205)     enddo
  1206)     cur_characteristic_curves%next => new_characteristic_curves
  1207)   else
  1208)     list => new_characteristic_curves
  1209)   endif
  1210)   
  1211) end subroutine CharacteristicCurvesAddToList
  1212) 
  1213) ! ************************************************************************** !
  1214) 
  1215) subroutine CharCurvesConvertListToArray(list,array,option)
  1216)   ! 
  1217)   ! Creates an array of pointers to the characteristic curves objects in the 
  1218)   ! list
  1219)   ! 
  1220)   ! Author: Glenn Hammond
  1221)   ! Date: 12/11/07
  1222)   ! 
  1223) 
  1224)   use String_module
  1225)   use Option_module
  1226)   
  1227)   implicit none
  1228)   
  1229)   class(characteristic_curves_type), pointer :: list
  1230)   type(characteristic_curves_ptr_type), pointer :: array(:)
  1231)   type(option_type) :: option
  1232)     
  1233)   class(characteristic_curves_type), pointer :: cur_characteristic_curves
  1234)   PetscInt :: count
  1235) 
  1236)   count = 0
  1237)   cur_characteristic_curves => list
  1238)   do 
  1239)     if (.not.associated(cur_characteristic_curves)) exit
  1240)     count = count + 1
  1241)     cur_characteristic_curves => cur_characteristic_curves%next
  1242)   enddo
  1243)   
  1244)   if (associated(array)) deallocate(array)
  1245)   allocate(array(count))
  1246)   
  1247)   count = 0
  1248)   cur_characteristic_curves => list
  1249)   do 
  1250)     if (.not.associated(cur_characteristic_curves)) exit
  1251)     count = count + 1
  1252)     array(count)%ptr => cur_characteristic_curves
  1253)     if (cur_characteristic_curves%test .and. &
  1254)         option%myrank == option%io_rank) then
  1255)       call CharacteristicCurvesTest(cur_characteristic_curves,option)
  1256)     endif
  1257)     cur_characteristic_curves => cur_characteristic_curves%next
  1258)   enddo
  1259) 
  1260) end subroutine CharCurvesConvertListToArray
  1261) 
  1262) ! ************************************************************************** !
  1263) 
  1264) function CharCurvesGetGetResidualSats(characteristic_curves,option)
  1265)   ! 
  1266)   ! Returns the residual saturations associated with a characteristic curves
  1267)   ! object
  1268)   ! 
  1269)   ! Author: Glenn Hammond
  1270)   ! Date: 09/29/14
  1271)   ! 
  1272) 
  1273)   use Option_module
  1274)   
  1275)   class(characteristic_curves_type) :: characteristic_curves
  1276)   type(option_type) :: option
  1277) 
  1278)   PetscReal :: CharCurvesGetGetResidualSats(option%nphase)
  1279) 
  1280)   CharCurvesGetGetResidualSats(1) = &
  1281)     characteristic_curves%liq_rel_perm_function%Sr
  1282)   if (option%nphase > 1) then
  1283)     select type(rpf=>characteristic_curves%gas_rel_perm_function)
  1284)       class is(rpf_Mualem_VG_liq_type)
  1285)         CharCurvesGetGetResidualSats(2) = rpf%Sr
  1286)       class is(rpf_Mualem_VG_gas_type)
  1287)         CharCurvesGetGetResidualSats(2) = rpf%Srg
  1288)       class is(rpf_Burdine_BC_liq_type)
  1289)         CharCurvesGetGetResidualSats(2) = rpf%Sr
  1290)       class is(rpf_Burdine_BC_gas_type)
  1291)         CharCurvesGetGetResidualSats(2) = rpf%Srg
  1292)       class is(rpf_Mualem_BC_liq_type)
  1293)         CharCurvesGetGetResidualSats(2) = rpf%Sr
  1294)       class is(rpf_Mualem_BC_gas_type)
  1295)         CharCurvesGetGetResidualSats(2) = rpf%Srg
  1296)       class is(rpf_Burdine_VG_liq_type)
  1297)         CharCurvesGetGetResidualSats(2) = rpf%Sr
  1298)       class is(rpf_Burdine_VG_gas_type)
  1299)         CharCurvesGetGetResidualSats(2) = rpf%Srg
  1300)       class is(rpf_TOUGH2_IRP7_gas_type)
  1301)         CharCurvesGetGetResidualSats(2) = rpf%Srg
  1302)       class is(rpf_Mualem_Linear_liq_type)
  1303)         CharCurvesGetGetResidualSats(2) = rpf%Sr
  1304)       class is(rpf_Mualem_Linear_gas_type)
  1305)         CharCurvesGetGetResidualSats(2) = rpf%Srg
  1306)       class is(rpf_Burdine_Linear_liq_type)
  1307)         CharCurvesGetGetResidualSats(2) = rpf%Sr
  1308)       class is(rpf_Burdine_Linear_gas_type)
  1309)         CharCurvesGetGetResidualSats(2) = rpf%Srg
  1310)       class is(rpf_BRAGFLO_KRP9_liq_type)
  1311)         CharCurvesGetGetResidualSats(2) = rpf%Sr
  1312)       class is(rpf_BRAGFLO_KRP9_gas_type)
  1313)         CharCurvesGetGetResidualSats(2) = rpf%Srg
  1314)       class is(rpf_BRAGFLO_KRP4_liq_type)
  1315)         CharCurvesGetGetResidualSats(2) = rpf%Sr
  1316)       class is(rpf_BRAGFLO_KRP4_gas_type)
  1317)         CharCurvesGetGetResidualSats(2) = rpf%Srg
  1318)       class is(rpf_BRAGFLO_KRP11_liq_type)
  1319)         CharCurvesGetGetResidualSats(2) = rpf%Sr
  1320)       class is(rpf_BRAGFLO_KRP11_gas_type)
  1321)         CharCurvesGetGetResidualSats(2) = rpf%Srg
  1322)       class is(rpf_TOUGH2_Linear_oil_type)
  1323)         CharCurvesGetGetResidualSats(2) = rpf%Sro
  1324)       class is(rpf_mod_BC_liq_type)
  1325)         CharCurvesGetGetResidualSats(2) = rpf%Sr
  1326)       class is(rpf_mod_BC_oil_type)
  1327)         CharCurvesGetGetResidualSats(2) = rpf%Sro
  1328)       class is(rel_perm_func_constant_type)
  1329)         CharCurvesGetGetResidualSats(2) = rpf%Sr
  1330)       class is(rel_perm_func_default_type)
  1331)         CharCurvesGetGetResidualSats(2) = rpf%Sr
  1332)       class default
  1333)         option%io_buffer = 'Relative permeability class not supported in ' // &
  1334)           'CharCurvesGetGetResidualSats.'
  1335)         call printErrMsg(option)
  1336)     end select
  1337)      
  1338)   endif
  1339) 
  1340) end function CharCurvesGetGetResidualSats
  1341) 
  1342) ! ************************************************************************** !
  1343) 
  1344) function CharacteristicCurvesGetID(characteristic_curves_array, &
  1345)                                    characteristic_curves_name, &
  1346)                                    material_property_name, option)
  1347)   ! 
  1348)   ! Returns the ID of the characteristic curves object named
  1349)   ! "characteristic_curves_name"
  1350)   ! 
  1351)   ! Author: Glenn Hammond
  1352)   ! Date: 01/12/11
  1353)   ! 
  1354) 
  1355)   use Option_module
  1356)   use String_module
  1357)   
  1358)   type(characteristic_curves_ptr_type), pointer :: &
  1359)     characteristic_curves_array(:)
  1360)   character(len=MAXWORDLENGTH) :: characteristic_curves_name
  1361)   character(len=MAXWORDLENGTH) :: material_property_name
  1362)   type(option_type) :: option
  1363) 
  1364)   PetscInt :: CharacteristicCurvesGetID
  1365) 
  1366)   CharacteristicCurvesGetID = 0
  1367)   do CharacteristicCurvesGetID = 1, size(characteristic_curves_array)
  1368)     if (StringCompare(characteristic_curves_name, &
  1369)                       characteristic_curves_array( &
  1370)                         CharacteristicCurvesGetID)%ptr%name)) then
  1371)       return
  1372)     endif
  1373)   enddo
  1374)   option%io_buffer = 'Characteristic curves "' // &
  1375)            trim(characteristic_curves_name) // &
  1376)            '" in material property "' // &
  1377)            trim(material_property_name) // &
  1378)            '" not found among available characteristic curves.'
  1379)   call printErrMsg(option)    
  1380) 
  1381) end function CharacteristicCurvesGetID
  1382) 
  1383) ! ************************************************************************** !
  1384) 
  1385) subroutine CharacteristicCurvesTest(characteristic_curves,option)
  1386)   ! 
  1387)   ! Outputs values of characteristic curves over a range of values
  1388)   ! 
  1389)   ! Author: Glenn Hammond
  1390)   ! Date: 09/29/14
  1391)   !
  1392)   use Option_module
  1393) 
  1394)   implicit none
  1395)   
  1396)   class(characteristic_curves_type) :: characteristic_curves
  1397)   type(option_type) :: option
  1398) 
  1399)   character(len=MAXWORDLENGTH) :: phase
  1400) 
  1401)   call characteristic_curves%saturation_function%Test( &
  1402)                                                  characteristic_curves%name, &
  1403)                                                  option)
  1404)   phase = 'liquid'
  1405)   call characteristic_curves%liq_rel_perm_function%Test( &
  1406)                                                  characteristic_curves%name, &
  1407)                                                  phase,option)
  1408)   phase = 'gas'
  1409)   call characteristic_curves%gas_rel_perm_function%Test( &
  1410)                                                  characteristic_curves%name, &
  1411)                                                  phase,option)
  1412) 
  1413)   if ( associated(characteristic_curves%oil_rel_perm_function) ) then
  1414)     phase = 'oil'
  1415)     call characteristic_curves%oil_rel_perm_function%Test( &
  1416)                                                  characteristic_curves%name, &
  1417)                                                  phase,option)
  1418)   end if
  1419)   
  1420) end subroutine CharacteristicCurvesTest
  1421) 
  1422) ! ************************************************************************** !
  1423) 
  1424) subroutine CharacteristicCurvesVerify(characteristic_curves,option)
  1425)   ! 
  1426)   ! Outputs values of characteristic curves over a range of values
  1427)   ! 
  1428)   ! Author: Glenn Hammond
  1429)   ! Date: 09/29/14
  1430)   !
  1431)   use Option_module
  1432) 
  1433)   implicit none
  1434)   
  1435)   class(characteristic_curves_type) :: characteristic_curves
  1436)   type(option_type) :: option
  1437)   
  1438)   character(len=MAXSTRINGLENGTH) :: string
  1439)   
  1440)   string = 'CHARACTERISTIC_CURVES(' // trim(characteristic_curves%name) // &
  1441)            '),'
  1442) 
  1443)   call characteristic_curves%saturation_function%Verify(string,option)
  1444)   call characteristic_curves%liq_rel_perm_function%Verify(string,option)
  1445) 
  1446)   if (associated(characteristic_curves%gas_rel_perm_function) ) then
  1447)     call characteristic_curves%gas_rel_perm_function%Verify(string,option)
  1448)   end if
  1449) 
  1450)   if ( associated(characteristic_curves%oil_rel_perm_function) ) then  
  1451)     call characteristic_curves%oil_rel_perm_function%Verify(string,option) 
  1452)   end if
  1453)   
  1454) end subroutine CharacteristicCurvesVerify
  1455) 
  1456) ! **************************************************************************** !
  1457) 
  1458) subroutine CharCurvesInputRecord(char_curve_list)
  1459)   ! 
  1460)   ! Prints ingested characteristic curves information to the input record file
  1461)   ! 
  1462)   ! Author: Jenn Frederick
  1463)   ! Date: 04/11/2016
  1464)   ! 
  1465) 
  1466)   implicit none
  1467) 
  1468)   class(characteristic_curves_type), pointer :: char_curve_list
  1469)   
  1470)   class(characteristic_curves_type), pointer :: cur_ccurve
  1471)   character(len=MAXWORDLENGTH) :: word1, word2
  1472)   character(len=MAXSTRINGLENGTH) :: string
  1473)   PetscInt :: id = INPUT_RECORD_UNIT
  1474) 
  1475)   write(id,'(a)') ' '
  1476)   write(id,'(a)') '---------------------------------------------------------&
  1477)                   &-----------------------'
  1478)   write(id,'(a29)',advance='no') '---------------------------: '
  1479)   write(id,'(a)') 'CHARACTERISTIC CURVES'
  1480)   
  1481)   cur_ccurve => char_curve_list
  1482)   do
  1483)     if (.not.associated(cur_ccurve)) exit
  1484)     
  1485)     write(id,'(a29)',advance='no') 'characteristic curve name: '
  1486)     write(id,'(a)') adjustl(trim(cur_ccurve%name))
  1487)     
  1488)     if (associated(cur_ccurve%saturation_function)) then
  1489)       write(id,'(a29)',advance='no') 'saturation function: '
  1490)       select type (sf => cur_ccurve%saturation_function)
  1491)       !---------------------------------
  1492)         class is (sat_func_VG_type)
  1493)           write(id,'(a)') 'van genuchten'
  1494)           write(id,'(a29)',advance='no') 'm: '
  1495)           write(word1,*) sf%m
  1496)           write(id,'(a)') adjustl(trim(word1))
  1497)           write(id,'(a29)',advance='no') 'alpha: '
  1498)           write(word1,*) sf%alpha
  1499)           write(id,'(a)') adjustl(trim(word1))
  1500)       !---------------------------------
  1501)         class is (sat_func_BC_type)
  1502)           write(id,'(a)') 'brooks corey'
  1503)           write(id,'(a29)',advance='no') 'alpha: '
  1504)           write(word1,*) sf%alpha
  1505)           write(id,'(a)') adjustl(trim(word1))
  1506)           write(id,'(a29)',advance='no') 'lambda: '
  1507)           write(word1,*) sf%lambda
  1508)           write(id,'(a)') adjustl(trim(word1))
  1509)       !---------------------------------
  1510)         class is (sat_func_Linear_type)
  1511)           write(id,'(a)') 'linear'
  1512)           write(id,'(a29)',advance='no') 'alpha: '
  1513)           write(word1,*) sf%alpha
  1514)           write(id,'(a)') adjustl(trim(word1))
  1515)       !---------------------------------
  1516)         class is (sat_func_BF_KRP9_type)
  1517)           write(id,'(a)') 'Bragflo KRP9 modified brooks corey'
  1518)       !---------------------------------
  1519)         class is (sat_func_BF_KRP4_type)
  1520)           write(id,'(a)') 'Bragflo KRP4 modified brooks corey'
  1521)           write(id,'(a29)',advance='no') 'alpha: '
  1522)           write(word1,*) sf%alpha
  1523)           write(id,'(a)') adjustl(trim(word1))
  1524)           write(id,'(a29)',advance='no') 'lambda: '
  1525)           write(word1,*) sf%lambda
  1526)           write(id,'(a)') adjustl(trim(word1))
  1527)           write(id,'(a29)',advance='no') 'gas residual sat.: '
  1528)           write(word1,*) sf%Srg
  1529)           write(id,'(a)') adjustl(trim(word1))
  1530)           write(id,'(a29)',advance='no') 'kpc: '
  1531)           write(word1,*) sf%pcmax_flag
  1532)           write(id,'(a)') adjustl(trim(word1))
  1533)       !---------------------------------
  1534)         class is (sat_func_BF_KRP11_type)
  1535)           write(id,'(a)') 'Bragflo KRP11 modified brooks corey'
  1536)       !---------------------------------
  1537)         class is (sat_func_BF_KRP12_type)
  1538)           write(id,'(a)') 'Bragflo KRP12 modified brooks corey'
  1539)           write(id,'(a29)',advance='no') 'alpha: '
  1540)           write(word1,*) sf%alpha
  1541)           write(id,'(a)') adjustl(trim(word1))
  1542)           write(id,'(a29)',advance='no') 'lambda: '
  1543)           write(word1,*) sf%lambda
  1544)           write(id,'(a)') adjustl(trim(word1))
  1545)           write(id,'(a29)',advance='no') 'gas residual sat.: '
  1546)           write(word1,*) sf%Srg
  1547)           write(id,'(a)') adjustl(trim(word1))
  1548)           write(id,'(a29)',advance='no') 'socmin: '
  1549)           write(word1,*) sf%socmin
  1550)           write(id,'(a)') adjustl(trim(word1))
  1551)           write(id,'(a29)',advance='no') 'soceffmin: '
  1552)           write(word1,*) sf%soceffmin
  1553)           write(id,'(a)') adjustl(trim(word1))
  1554)       !---------------------------------
  1555)         class is (sat_func_default_type)
  1556)           write(id,'(a)') 'default'
  1557)       !---------------------------------
  1558)       end select
  1559)       write(id,'(a29)',advance='no') 'liquid residual sat.: '
  1560)       write(word1,*) cur_ccurve%saturation_function%Sr
  1561)       write(id,'(a)') adjustl(trim(word1))
  1562)       write(id,'(a29)',advance='no') 'max capillary pressure: '
  1563)       write(word1,*) cur_ccurve%saturation_function%pcmax
  1564)       write(id,'(a)') adjustl(trim(word1))
  1565)     endif
  1566)     
  1567)     if (associated(cur_ccurve%liq_rel_perm_function)) then
  1568)       write(id,'(a29)',advance='no') 'liq. relative perm. func.: '
  1569)       select type (rpf => cur_ccurve%liq_rel_perm_function)
  1570)       !------------------------------------
  1571)         class is (rel_perm_func_default_type)
  1572)           write(id,'(a)') 'default'
  1573)       !------------------------------------
  1574)         class is (rpf_Mualem_VG_liq_type)
  1575)           write(id,'(a)') 'mualem_vg_liq/tough2_irp7_liq'
  1576)           write(id,'(a29)',advance='no') 'm: '
  1577)           write(word1,*) rpf%m
  1578)           write(id,'(a)') adjustl(trim(word1))
  1579)       !------------------------------------
  1580)         class is (rpf_Mualem_BC_liq_type)
  1581)           write(id,'(a)') 'mualem_bc_liq'
  1582)           write(id,'(a29)',advance='no') 'lambda: '
  1583)           write(word1,*) rpf%lambda
  1584)           write(id,'(a)') adjustl(trim(word1))
  1585)       !------------------------------------
  1586)         class is (rpf_Mualem_Linear_liq_type)
  1587)           write(id,'(a)') 'mualem_linear_liq'
  1588)           write(id,'(a29)',advance='no') 'alpha: '
  1589)           write(word1,*) rpf%alpha
  1590)           write(id,'(a)') adjustl(trim(word1))
  1591)           write(id,'(a29)',advance='no') 'max capillary pressure: '
  1592)           write(word1,*) rpf%pcmax
  1593)           write(id,'(a)') adjustl(trim(word1))
  1594)       !------------------------------------
  1595)         class is (rpf_Burdine_VG_liq_type)
  1596)           write(id,'(a)') 'burdine_vg_liq'
  1597)           write(id,'(a29)',advance='no') 'm: '
  1598)           write(word1,*) rpf%m
  1599)           write(id,'(a)') adjustl(trim(word1))
  1600)       !------------------------------------
  1601)         class is (rpf_Burdine_BC_liq_type)
  1602)           write(id,'(a)') 'burdine_bc_liq'
  1603)           write(id,'(a29)',advance='no') 'lambda: '
  1604)           write(word1,*) rpf%lambda
  1605)           write(id,'(a)') adjustl(trim(word1))
  1606)       !------------------------------------
  1607)         class is (rpf_Burdine_linear_liq_type)
  1608)           write(id,'(a)') 'burdine_linear_liq'
  1609)       !------------------------------------
  1610)         class is (rpf_BRAGFLO_KRP9_liq_type)
  1611)           write(id,'(a)') 'bragflo_krp9_liq'
  1612)       !------------------------------------
  1613)         class is (rpf_BRAGFLO_KRP4_liq_type)
  1614)           write(id,'(a)') 'bragflo_krp4_liq'
  1615)           write(id,'(a29)',advance='no') 'lambda: '
  1616)           write(word1,*) rpf%lambda
  1617)           write(id,'(a)') adjustl(trim(word1))
  1618)       !------------------------------------
  1619)         class is (rpf_BRAGFLO_KRP11_liq_type)
  1620)           write(id,'(a)') 'bragflo_krp11_liq'
  1621)           write(id,'(a29)',advance='no') 'tolc: '
  1622)           write(word1,*) rpf%tolc
  1623)           write(id,'(a)') adjustl(trim(word1))
  1624)       !------------------------------------
  1625)         class is (rpf_BRAGFLO_KRP12_liq_type)
  1626)           write(id,'(a)') 'bragflo_krp12_liq'
  1627)           write(id,'(a29)',advance='no') 'lambda: '
  1628)           write(word1,*) rpf%lambda
  1629)           write(id,'(a)') adjustl(trim(word1))
  1630)       !------------------------------------
  1631)         class default
  1632)           write(id,'(a)') 'none'
  1633)       !------------------------------------
  1634)       end select
  1635)     endif
  1636)     
  1637)     if (associated(cur_ccurve%gas_rel_perm_function)) then
  1638)       write(id,'(a29)',advance='no') 'gas relative perm. func.: '
  1639)       select type (rpf => cur_ccurve%gas_rel_perm_function)
  1640)       !------------------------------------
  1641)         class is (rel_perm_func_default_type)
  1642)           write(id,'(a)') 'default'
  1643)       !------------------------------------
  1644)         class is (rpf_Mualem_VG_gas_type)
  1645)           write(id,'(a)') 'mualem_vg_gas'
  1646)           write(id,'(a29)',advance='no') 'm: '
  1647)           write(word1,*) rpf%m
  1648)           write(id,'(a)') adjustl(trim(word1))
  1649)           write(id,'(a29)',advance='no') 'gas residual sat.: '
  1650)           write(word1,*) rpf%Srg
  1651)           write(id,'(a)') adjustl(trim(word1))
  1652)       !------------------------------------
  1653)         class is (rpf_Mualem_BC_gas_type)
  1654)           write(id,'(a)') 'mualem_bc_gas'
  1655)           write(id,'(a29)',advance='no') 'lambda: '
  1656)           write(word1,*) rpf%lambda
  1657)           write(id,'(a)') adjustl(trim(word1))
  1658)           write(id,'(a29)',advance='no') 'gas residual sat.: '
  1659)           write(word1,*) rpf%Srg
  1660)           write(id,'(a)') adjustl(trim(word1))
  1661)       !------------------------------------
  1662)         class is (rpf_Mualem_Linear_gas_type)
  1663)           write(id,'(a)') 'mualem_linear_gas'
  1664)           write(id,'(a29)',advance='no') 'alpha: '
  1665)           write(word1,*) rpf%alpha
  1666)           write(id,'(a)') adjustl(trim(word1))
  1667)           write(id,'(a29)',advance='no') 'max capillary pressure: '
  1668)           write(word1,*) rpf%pcmax
  1669)           write(id,'(a)') adjustl(trim(word1))
  1670)           write(id,'(a29)',advance='no') 'gas residual sat.: '
  1671)           write(word1,*) rpf%Srg
  1672)           write(id,'(a)') adjustl(trim(word1))
  1673)       !------------------------------------
  1674)         class is (rpf_TOUGH2_IRP7_gas_type)
  1675)           write(id,'(a)') 'tough2_irp7_gas'
  1676)           write(id,'(a29)',advance='no') 'm: '
  1677)           write(word1,*) rpf%m
  1678)           write(id,'(a)') adjustl(trim(word1))
  1679)           write(id,'(a29)',advance='no') 'gas residual sat.: '
  1680)           write(word1,*) rpf%Srg
  1681)           write(id,'(a)') adjustl(trim(word1))
  1682)       !------------------------------------
  1683)         class is (rpf_Burdine_VG_gas_type)
  1684)           write(id,'(a)') 'burdine_vg_gas'
  1685)           write(id,'(a29)',advance='no') 'm: '
  1686)           write(word1,*) rpf%m
  1687)           write(id,'(a)') adjustl(trim(word1))
  1688)           write(id,'(a29)',advance='no') 'gas residual sat.: '
  1689)           write(word1,*) rpf%Srg
  1690)           write(id,'(a)') adjustl(trim(word1))
  1691)       !------------------------------------
  1692)         class is (rpf_Burdine_BC_gas_type)
  1693)           write(id,'(a)') 'burdine_bc_gas'
  1694)           write(id,'(a29)',advance='no') 'lambda: '
  1695)           write(word1,*) rpf%lambda
  1696)           write(id,'(a)') adjustl(trim(word1))
  1697)           write(id,'(a29)',advance='no') 'gas residual sat.: '
  1698)           write(word1,*) rpf%Srg
  1699)           write(id,'(a)') adjustl(trim(word1))
  1700)       !------------------------------------
  1701)         class is (rpf_Burdine_linear_gas_type)
  1702)           write(id,'(a)') 'burdine_linear_gas'
  1703)           write(id,'(a29)',advance='no') 'gas residual sat.: '
  1704)           write(word1,*) rpf%Srg
  1705)           write(id,'(a)') adjustl(trim(word1))
  1706)       !------------------------------------
  1707)         class is (rpf_BRAGFLO_KRP9_gas_type)
  1708)           write(id,'(a)') 'bragflo_krp9_gas'
  1709)           write(id,'(a29)',advance='no') 'gas residual sat.: '
  1710)           write(word1,*) rpf%Srg
  1711)           write(id,'(a)') adjustl(trim(word1))
  1712)       !------------------------------------
  1713)         class is (rpf_BRAGFLO_KRP4_gas_type)
  1714)           write(id,'(a)') 'bragflo_krp4_gas'
  1715)           write(id,'(a29)',advance='no') 'lambda: '
  1716)           write(word1,*) rpf%lambda
  1717)           write(id,'(a)') adjustl(trim(word1))
  1718)           write(id,'(a29)',advance='no') 'gas residual sat.: '
  1719)           write(word1,*) rpf%Srg
  1720)           write(id,'(a)') adjustl(trim(word1))
  1721)       !------------------------------------
  1722)         class is (rpf_BRAGFLO_KRP11_gas_type)
  1723)           write(id,'(a)') 'bragflo_krp11_gas'
  1724)           write(id,'(a29)',advance='no') 'tolc: '
  1725)           write(word1,*) rpf%tolc
  1726)           write(id,'(a)') adjustl(trim(word1))
  1727)           write(id,'(a29)',advance='no') 'gas residual sat.: '
  1728)           write(word1,*) rpf%Srg
  1729)           write(id,'(a)') adjustl(trim(word1))
  1730)       !------------------------------------
  1731)         class is (rpf_BRAGFLO_KRP12_gas_type)
  1732)           write(id,'(a)') 'bragflo_krp12_gas'
  1733)           write(id,'(a29)',advance='no') 'lambda: '
  1734)           write(word1,*) rpf%lambda
  1735)           write(id,'(a)') adjustl(trim(word1))
  1736)           write(id,'(a29)',advance='no') 'gas residual sat.: '
  1737)           write(word1,*) rpf%Srg
  1738)           write(id,'(a)') adjustl(trim(word1))
  1739)       !------------------------------------
  1740)         class default
  1741)           write(id,'(a)') 'none'
  1742)       !------------------------------------
  1743)       end select
  1744)     endif
  1745)     
  1746)     if (associated(cur_ccurve%oil_rel_perm_function)) then
  1747)       write(id,'(a29)',advance='no') 'oil relative perm. func.: '
  1748)       select type (rpf => cur_ccurve%oil_rel_perm_function)
  1749)       !------------------------------------
  1750)         class is (rel_perm_func_default_type)
  1751)           write(id,'(a)') 'default'
  1752)       !------------------------------------
  1753)         class is (rpf_TOUGH2_Linear_Oil_type)
  1754)           write(id,'(a)') 'tough2_linear_oil'
  1755)           write(id,'(a29)',advance='no') 'oil residual sat.: '
  1756)           write(word1,*) rpf%Sro
  1757)           write(id,'(a)') adjustl(trim(word1))
  1758)       !------------------------------------
  1759)       end select
  1760)     endif
  1761) 
  1762)     write(id,'(a29)') '---------------------------: '
  1763)     cur_ccurve => cur_ccurve%next
  1764)   enddo
  1765)   
  1766) end subroutine CharCurvesInputRecord
  1767) 
  1768) ! End Characteristic Curves
  1769) 
  1770) ! ************************************************************************** !
  1771) 
  1772) ! Begin Base Routines
  1773) function PolynomialCreate()
  1774) 
  1775)   implicit none
  1776)   
  1777)   type(polynomial_type), pointer :: PolynomialCreate  
  1778) 
  1779)   allocate(PolynomialCreate)
  1780)   PolynomialCreate%low = 0.d0
  1781)   PolynomialCreate%high = 0.d0
  1782)   PolynomialCreate%coefficients(:) = 0.d0
  1783)   
  1784) end function PolynomialCreate
  1785) 
  1786) ! ************************************************************************** !
  1787) 
  1788) subroutine SFBaseInit(this)
  1789) 
  1790)   implicit none
  1791)   
  1792)   class(sat_func_base_type) :: this  
  1793) 
  1794)   ! Cannot allocate here.  Allocation takes place in daughter class
  1795)   nullify(this%sat_poly)
  1796)   nullify(this%pres_poly)
  1797)   this%Sr = UNINITIALIZED_DOUBLE
  1798)   this%pcmax = DEFAULT_PCMAX
  1799)   
  1800) end subroutine SFBaseInit
  1801) 
  1802) ! ************************************************************************** !
  1803) 
  1804) subroutine SFBaseVerify(this,name,option)
  1805) 
  1806)   use Option_module
  1807)   
  1808)   implicit none
  1809)   
  1810)   class(sat_func_base_type) :: this  
  1811)   character(len=MAXSTRINGLENGTH) :: name
  1812)   type(option_type) :: option  
  1813)   
  1814)   if (Uninitialized(this%Sr)) then
  1815)     option%io_buffer = UninitializedMessage('LIQUID_RESIDUAL_SATURATION', &
  1816)                                             name)
  1817)     call printErrMsg(option)
  1818)   endif
  1819)   
  1820) end subroutine SFBaseVerify
  1821) 
  1822) ! ************************************************************************** !
  1823) 
  1824) subroutine RPFBaseInit(this)
  1825) 
  1826)   implicit none
  1827)   
  1828)   class(rel_perm_func_base_type) :: this  
  1829) 
  1830)   ! Cannot allocate here.  Allocation takes place in daughter class
  1831)   nullify(this%poly)
  1832)   this%Sr = UNINITIALIZED_DOUBLE
  1833)   
  1834) end subroutine RPFBaseInit
  1835) 
  1836) ! ************************************************************************** !
  1837) 
  1838) subroutine RPFBaseVerify(this,name,option)
  1839) 
  1840)   use Option_module
  1841)   
  1842)   implicit none
  1843)   
  1844)   class(rel_perm_func_base_type) :: this  
  1845)   character(len=MAXSTRINGLENGTH) :: name
  1846)   type(option_type) :: option  
  1847) 
  1848)   if (Uninitialized(this%Sr)) then
  1849)     option%io_buffer = UninitializedMessage('LIQUID_RESIDUAL_SATURATION', &
  1850)                                             name)
  1851)     call printErrMsg(option)
  1852)   endif
  1853)   
  1854) end subroutine RPFBaseVerify
  1855) 
  1856) ! ************************************************************************** !
  1857) 
  1858) subroutine SFBaseSetupPolynomials(this,option,error_string)
  1859) 
  1860)   ! Sets up polynomials for smoothing saturation functions
  1861) 
  1862)   use Option_module
  1863)   
  1864)   implicit none
  1865)   
  1866)   class(sat_func_base_type) :: this
  1867)   type(option_type) :: option
  1868)   character(len=MAXSTRINGLENGTH) :: error_string
  1869)   
  1870)   option%io_buffer = 'Smoothing not supported for ' // trim(error_string)
  1871)   call printErrMsg(option)
  1872)   
  1873) end subroutine SFBaseSetupPolynomials
  1874) 
  1875) ! ************************************************************************** !
  1876) 
  1877) subroutine RPFBaseSetupPolynomials(this,option,error_string)
  1878) 
  1879)   ! Sets up polynomials for smoothing relative permeability functions
  1880) 
  1881)   use Option_module
  1882)   
  1883)   implicit none
  1884)   
  1885)   class(rel_perm_func_base_type) :: this
  1886)   type(option_type) :: option
  1887)   character(len=MAXSTRINGLENGTH) :: error_string
  1888)   
  1889)   option%io_buffer = 'Smoothing not supported for ' // trim(error_string)
  1890)   call printErrMsg(option)
  1891)   
  1892) end subroutine RPFBaseSetupPolynomials
  1893) 
  1894) ! ************************************************************************** !
  1895) 
  1896) subroutine SFBaseCapillaryPressure(this,liquid_saturation, &
  1897)                                      capillary_pressure,option)
  1898)   use Option_module
  1899)   
  1900)   implicit none
  1901)   
  1902)   class(sat_func_base_type) :: this
  1903)   PetscReal, intent(in) :: liquid_saturation
  1904)   PetscReal, intent(out) :: capillary_pressure
  1905)   type(option_type), intent(inout) :: option
  1906)   
  1907)   option%io_buffer = 'SFBaseCapillaryPressure must be extended.'
  1908)   call printErrMsg(option)
  1909)   
  1910) end subroutine SFBaseCapillaryPressure
  1911) 
  1912) ! ************************************************************************** !
  1913) 
  1914) subroutine SFBaseSaturation(this,capillary_pressure,liquid_saturation, &
  1915)                               dsat_dpres,option)
  1916)   use Option_module
  1917) 
  1918)   implicit none
  1919)   
  1920)   class(sat_func_base_type) :: this
  1921)   PetscReal, intent(in) :: capillary_pressure
  1922)   PetscReal, intent(out) :: liquid_saturation
  1923)   PetscReal, intent(out) :: dsat_dpres
  1924)   type(option_type), intent(inout) :: option
  1925)   
  1926)   option%io_buffer = 'SFBaseSaturation must be extended.'
  1927)   call printErrMsg(option)
  1928)   
  1929) end subroutine SFBaseSaturation
  1930) 
  1931) ! ************************************************************************** !
  1932) 
  1933) subroutine SFBaseTest(this,cc_name,option)
  1934) 
  1935)   use Option_module
  1936) 
  1937)   implicit none
  1938)   
  1939)   class(sat_func_base_type) :: this
  1940)   character(len=MAXWORDLENGTH) :: cc_name
  1941)   type(option_type), intent(inout) :: option
  1942)   
  1943)   character(len=MAXSTRINGLENGTH) :: string
  1944)   PetscReal :: pc, pc_increment
  1945)   PetscReal :: capillary_pressure(101)
  1946)   PetscReal :: liquid_saturation(101)
  1947)   PetscReal :: dummy_real
  1948)   PetscInt :: count, i
  1949) 
  1950)   ! calculate saturation as a function of capillary pressure
  1951)   ! start at 1 Pa up to maximum capillary pressure
  1952)   pc = 1.d0
  1953)   pc_increment = 1.d0
  1954)   count = 0
  1955)   do
  1956)     if (pc > this%pcmax) exit
  1957)     count = count + 1
  1958)     call this%Saturation(pc,liquid_saturation(count),dummy_real,option)
  1959)     capillary_pressure(count) = pc
  1960)     if (pc > 0.99d0*pc_increment*10.d0) pc_increment = pc_increment*10.d0
  1961)     pc = pc + pc_increment
  1962)   enddo
  1963) 
  1964)   write(string,*) cc_name
  1965)   string = trim(cc_name) // '_pc_sat.dat'
  1966)   open(unit=86,file=string)
  1967)   write(86,*) '"capillary pressure", "saturation"'
  1968)   do i = 1, count
  1969)     write(86,'(2es14.6)') capillary_pressure(i), liquid_saturation(i)
  1970)   enddo
  1971)   close(86)
  1972) 
  1973)  ! calculate capillary pressure as a function of saturation
  1974)   do i = 1, 101
  1975)     liquid_saturation(i) = dble(i-1)*0.01d0
  1976)     call this%CapillaryPressure(liquid_saturation(i),capillary_pressure(i), &
  1977)                                 option)
  1978)   enddo
  1979)   count = 101
  1980) 
  1981)   write(string,*) cc_name
  1982)   string = trim(cc_name) // '_sat_pc.dat'
  1983)   open(unit=86,file=string)
  1984)   write(86,*) '"saturation", "capillary pressure"'
  1985)   do i = 1, count
  1986)     write(86,'(2es14.6)') liquid_saturation(i), capillary_pressure(i)
  1987)   enddo
  1988)   close(86)
  1989) 
  1990) end subroutine SFBaseTest
  1991) 
  1992) ! ************************************************************************** !
  1993) 
  1994) subroutine RPF_Base_RelPerm(this,liquid_saturation,relative_permeability, &
  1995)                             dkr_sat,option)
  1996)   use Option_module
  1997) 
  1998)   implicit none
  1999)   
  2000)   class(rel_perm_func_base_type) :: this
  2001)   PetscReal, intent(in) :: liquid_saturation
  2002)   PetscReal, intent(out) :: relative_permeability
  2003)   PetscReal, intent(out) :: dkr_sat
  2004)   type(option_type), intent(inout) :: option
  2005)   
  2006)   option%io_buffer = 'RPF_Base_RelPerm must be extended.'
  2007)   call printErrMsg(option)
  2008)   
  2009) end subroutine RPF_Base_RelPerm
  2010) 
  2011) ! ************************************************************************** !
  2012) 
  2013) subroutine RPF_Base_Test(this,cc_name,phase,option)
  2014) 
  2015)   use Option_module
  2016) 
  2017)   implicit none
  2018)   
  2019)   class(rel_perm_func_base_type) :: this
  2020)   character(len=MAXWORDLENGTH) :: cc_name
  2021)   character(len=MAXWORDLENGTH) :: phase
  2022)   type(option_type), intent(inout) :: option
  2023)   
  2024)   character(len=MAXSTRINGLENGTH) :: string
  2025)   PetscReal :: dummy_real
  2026)   PetscInt :: i
  2027)   PetscReal :: liquid_saturation(101), kr(101)
  2028) 
  2029)   do i = 1, 101
  2030)     liquid_saturation(i) = dble(i-1)*0.01d0
  2031)     call this%RelativePermeability(liquid_saturation(i),kr(i),dummy_real, &
  2032)                                    option)
  2033)   enddo
  2034) 
  2035)   write(string,*) cc_name
  2036)   string = trim(cc_name) // '_' // trim(phase) // '_rel_perm.dat'
  2037)   open(unit=86,file=string)
  2038)   write(86,*) '"saturation", "' // trim(phase) // ' relative permeability"'
  2039)   do i = 1, size(liquid_saturation)
  2040)     write(86,'(2es14.6)') liquid_saturation(i), kr(i)
  2041)   enddo
  2042)   close(86)
  2043) 
  2044) end subroutine RPF_Base_Test
  2045) ! End Base Routines
  2046) 
  2047) ! ************************************************************************** !
  2048) 
  2049) ! Begin SF: Default
  2050) function SF_Default_Create()
  2051) 
  2052)   ! Creates the default saturation function object
  2053) 
  2054)   implicit none
  2055)   
  2056)   class(sat_func_default_type), pointer :: SF_Default_Create
  2057)   
  2058)   allocate(SF_Default_Create)
  2059)   call SFBaseInit(SF_Default_Create)
  2060)   SF_Default_Create%Sr = 0.d0
  2061)   
  2062) end function SF_Default_Create
  2063) 
  2064) ! ************************************************************************** !
  2065) 
  2066) subroutine SFDefaultVerify(this,name,option)
  2067) 
  2068)   use Option_module
  2069)   
  2070)   implicit none
  2071)   
  2072)   class(sat_func_default_type) :: this  
  2073)   character(len=MAXSTRINGLENGTH) :: name
  2074)   type(option_type) :: option  
  2075) 
  2076)   option%io_buffer = 'A default Saturation Function has been chosen in ' // &
  2077)     trim(name) // '.'
  2078)   call printWrnMsg(option)
  2079)   
  2080) end subroutine SFDefaultVerify
  2081) 
  2082) ! ************************************************************************** !
  2083) 
  2084) subroutine SFDefaultCapillaryPressure(this,liquid_saturation, &
  2085)                                       capillary_pressure,option)
  2086)   use Option_module
  2087)   
  2088)   implicit none
  2089)   
  2090)   class(sat_func_default_type) :: this
  2091)   PetscReal, intent(in) :: liquid_saturation
  2092)   PetscReal, intent(out) :: capillary_pressure
  2093)   type(option_type), intent(inout) :: option
  2094)   
  2095)   if (liquid_saturation < 1.d0) then
  2096)     option%io_buffer = 'SFDefaultCapillaryPressure is a dummy routine used &
  2097)       &for saturated flow only.  The user must specify a valid &
  2098)       &SATURATION_FUNCTION.'
  2099)     call printErrMsgByRank(option)
  2100)   endif
  2101) 
  2102) end subroutine SFDefaultCapillaryPressure
  2103) 
  2104) ! ************************************************************************** !
  2105) 
  2106) subroutine SFDefaultSaturation(this,capillary_pressure,liquid_saturation, &
  2107)                                dsat_dpres,option)
  2108)   use Option_module
  2109) 
  2110)   implicit none
  2111)   
  2112)   class(sat_func_default_type) :: this
  2113)   PetscReal, intent(in) :: capillary_pressure
  2114)   PetscReal, intent(out) :: liquid_saturation
  2115)   PetscReal, intent(out) :: dsat_dpres
  2116)   type(option_type), intent(inout) :: option
  2117)   
  2118)   option%io_buffer = 'SFDefaultSaturation is a dummy routine used &
  2119)     &for saturated flow only.  The user must specify a valid &
  2120)     &SATURATION_FUNCTION.'
  2121)   call printErrMsgByRank(option)
  2122) 
  2123) end subroutine SFDefaultSaturation
  2124) 
  2125) ! ************************************************************************** !
  2126) 
  2127) function RPF_Default_Create()
  2128) 
  2129)   ! Creates the default relative permeability function object
  2130) 
  2131)   implicit none
  2132)   
  2133)   class(rel_perm_func_default_type), pointer :: RPF_Default_Create
  2134)   
  2135)   allocate(RPF_Default_Create)
  2136)   call RPFBaseInit(RPF_Default_Create)
  2137)   RPF_Default_Create%Sr = 0.d0
  2138)   
  2139) end function RPF_Default_Create
  2140) 
  2141) ! ************************************************************************** !
  2142) 
  2143) subroutine RPFDefaultVerify(this,name,option)
  2144) 
  2145)   use Option_module
  2146)   
  2147)   implicit none
  2148)   
  2149)   class(rel_perm_func_default_type) :: this  
  2150)   character(len=MAXSTRINGLENGTH) :: name
  2151)   type(option_type) :: option  
  2152) 
  2153)   option%io_buffer = 'A default Relative Permeability Function has been ' // &
  2154)     'chosen in ' // trim(name) // '.'
  2155)   call printWrnMsg(option)
  2156) 
  2157) end subroutine RPFDefaultVerify
  2158) 
  2159) ! ************************************************************************** !
  2160) 
  2161) subroutine RPF_DefaultRelPerm(this,liquid_saturation,relative_permeability, &
  2162)                             dkr_sat,option)
  2163)   use Option_module
  2164) 
  2165)   implicit none
  2166)   
  2167)   class(rel_perm_func_default_type) :: this
  2168)   PetscReal, intent(in) :: liquid_saturation
  2169)   PetscReal, intent(out) :: relative_permeability
  2170)   PetscReal, intent(out) :: dkr_sat
  2171)   type(option_type), intent(inout) :: option
  2172)   
  2173)   if (liquid_saturation < 1.d0) then
  2174)     option%io_buffer = 'RPF_Default_RelPerm is a dummy routine used &
  2175)       &for saturated flow only.  The user must specify a valid &
  2176)       &PERMEABILITY_FUNCTION.'
  2177)     call printErrMsgByRank(option)
  2178)   endif
  2179)   relative_permeability = 1.d0
  2180)   
  2181) end subroutine RPF_DefaultRelPerm
  2182) ! End Default Routines
  2183) 
  2184) ! ************************************************************************** !
  2185) 
  2186) ! Begin SF: van Genuchten
  2187) function SF_VG_Create()
  2188) 
  2189)   ! Creates the van Genutchten capillary pressure function object
  2190) 
  2191)   implicit none
  2192)   
  2193)   class(sat_func_VG_type), pointer :: SF_VG_Create
  2194)   
  2195)   allocate(SF_VG_Create)
  2196)   call SF_VG_Create%Init()
  2197)   
  2198) end function SF_VG_Create
  2199) 
  2200) ! ************************************************************************** !
  2201) 
  2202) subroutine SF_VG_Init(this)
  2203) 
  2204)   ! Creates the van Genutchten capillary pressure function object
  2205) 
  2206)   implicit none
  2207)   
  2208)   class(sat_func_VG_type) :: this
  2209) 
  2210)   call SFBaseInit(this)
  2211)   this%alpha = UNINITIALIZED_DOUBLE
  2212)   this%m = UNINITIALIZED_DOUBLE
  2213)   
  2214) end subroutine SF_VG_Init
  2215) 
  2216) ! ************************************************************************** !
  2217) 
  2218) subroutine SF_VG_Verify(this,name,option)
  2219) 
  2220)   use Option_module
  2221)   
  2222)   implicit none
  2223)   
  2224)   class(sat_func_VG_type) :: this
  2225)   character(len=MAXSTRINGLENGTH) :: name
  2226)   type(option_type) :: option
  2227)   
  2228)   character(len=MAXSTRINGLENGTH) :: string
  2229)   
  2230)   if (index(name,'SATURATION_FUNCTION') > 0) then
  2231)     string = name
  2232)   else
  2233)     string = trim(name) // 'SATURATION_FUNCTION,VAN_GENUCHTEN'
  2234)   endif
  2235)   call SFBaseVerify(this,string,option)
  2236)   if (Uninitialized(this%alpha)) then
  2237)     option%io_buffer = UninitializedMessage('ALPHA',string)
  2238)     call printErrMsg(option)
  2239)   endif   
  2240)   if (Uninitialized(this%m)) then
  2241)     option%io_buffer = UninitializedMessage('M',string)
  2242)     call printErrMsg(option)
  2243)   endif   
  2244) 
  2245) end subroutine SF_VG_Verify
  2246) 
  2247) ! ************************************************************************** !
  2248) 
  2249) subroutine SF_VG_CapillaryPressure(this,liquid_saturation, &
  2250)                                    capillary_pressure,option)
  2251)   ! 
  2252)   ! Computes the capillary_pressure as a function of saturation
  2253)   ! 
  2254)   ! (1) Chen, J., J.W. Hopmans, M.E. Grismer (1999) "Parameter estimation of
  2255)   !     of two-fluid capillary pressure-saturation and permeability functions",
  2256)   !     Advances in Water Resources, Vol. 22, No. 5, pp 479-493,
  2257)   !     http://dx.doi.org/10.1016/S0309-1708(98)00025-6.
  2258)   !   
  2259)   ! Author: Glenn Hammond
  2260)   ! Date: 12/11/07, 09/23/14
  2261)   !
  2262)   use Option_module
  2263)   
  2264)   implicit none
  2265)   
  2266)   class(sat_func_VG_type) :: this
  2267)   PetscReal, intent(in) :: liquid_saturation
  2268)   PetscReal, intent(out) :: capillary_pressure
  2269)   type(option_type), intent(inout) :: option
  2270)   
  2271)   PetscReal :: n
  2272)   PetscReal :: Se
  2273)   PetscReal :: one_plus_pc_alpha_n
  2274)   PetscReal :: pc_alpha_n
  2275)   PetscReal :: pc_alpha
  2276)   
  2277)   if (liquid_saturation <= this%Sr) then
  2278)     capillary_pressure = this%pcmax
  2279)     return
  2280)   else if (liquid_saturation >= 1.d0) then
  2281)     capillary_pressure = 0.d0
  2282)     return
  2283)   endif
  2284)   
  2285)   n = 1.d0/(1.d0-this%m)
  2286)   Se = (liquid_saturation-this%Sr)/(1.d0-this%Sr)
  2287)   one_plus_pc_alpha_n = Se**(-1.d0/this%m)
  2288)   pc_alpha_n = one_plus_pc_alpha_n - 1.d0
  2289)   pc_alpha = pc_alpha_n**(1.d0/n)
  2290)   capillary_pressure = pc_alpha/this%alpha  
  2291) #if defined(MATCH_TOUGH2)
  2292)   if (liquid_saturation > 0.999d0) then
  2293)     capillary_pressure = capillary_pressure*(1.d0-liquid_saturation)/0.001d0
  2294)   endif
  2295) #endif
  2296) 
  2297) 
  2298)   capillary_pressure = min(capillary_pressure,this%pcmax)
  2299)   
  2300) end subroutine SF_VG_CapillaryPressure
  2301) 
  2302) ! ************************************************************************** !
  2303) 
  2304) subroutine SF_VG_Saturation(this,capillary_pressure,liquid_saturation, &
  2305)                             dsat_dpres,option)
  2306)   ! 
  2307)   ! Computes the saturation (and associated derivatives) as a function of 
  2308)   ! capillary pressure
  2309)   ! 
  2310)   ! (1) Chen, J., J.W. Hopmans, M.E. Grismer (1999) "Parameter estimation of
  2311)   !     of two-fluid capillary pressure-saturation and permeability functions",
  2312)   !     Advances in Water Resources, Vol. 22, No. 5, pp 479-493,
  2313)   !     http://dx.doi.org/10.1016/S0309-1708(98)00025-6.
  2314)   !   
  2315)   ! Author: Glenn Hammond
  2316)   ! Date: 12/11/07, 09/23/14
  2317)   !
  2318)   use Option_module
  2319)   use Utility_module
  2320)   
  2321)   implicit none
  2322) 
  2323)   class(sat_func_VG_type) :: this
  2324)   PetscReal, intent(in) :: capillary_pressure
  2325)   PetscReal, intent(out) :: liquid_saturation
  2326)   PetscReal, intent(out) :: dsat_dpres
  2327)   type(option_type), intent(inout) :: option
  2328)   
  2329)   PetscReal, parameter :: pc_alpha_n_epsilon = 1.d-15
  2330)   PetscReal :: n
  2331)   PetscReal :: pc_alpha
  2332)   PetscReal :: pc_alpha_n
  2333)   PetscReal :: one_plus_pc_alpha_n
  2334)   PetscReal :: Se
  2335)   PetscReal :: dSe_dpc
  2336)   
  2337)   dsat_dpres = 0.d0
  2338)   
  2339)   if (associated(this%pres_poly)) then
  2340)     if (capillary_pressure < this%pres_poly%low) then
  2341)       liquid_saturation = 1.d0
  2342)       return
  2343)     else if (capillary_pressure < this%pres_poly%high) then
  2344)       call CubicPolynomialEvaluate(this%pres_poly%coefficients, &
  2345)                                    capillary_pressure,Se,dSe_dpc)
  2346)       liquid_saturation = this%Sr + (1.d0-this%Sr)*Se
  2347)       dsat_dpres = -(1.d0-this%Sr)*dSe_dpc
  2348)       return
  2349)     endif
  2350)   endif
  2351) 
  2352)   if (capillary_pressure <= 0.d0) then
  2353)     liquid_saturation = 1.d0
  2354)     return
  2355)   else
  2356)     n = 1.d0/(1.d0-this%m)
  2357)     pc_alpha = capillary_pressure*this%alpha
  2358)     pc_alpha_n = pc_alpha**n
  2359)     !geh:  This conditional does not catch potential cancelation in 
  2360)     !      the dkr_sat deriviative calculation.  Therefore, I am setting
  2361)     !      an epsilon here
  2362)     !   if (1.d0 + pc_alpha_n == 1.d0) then ! check for zero perturbation
  2363)     if (pc_alpha_n < pc_alpha_n_epsilon) then 
  2364)       liquid_saturation = 1.d0
  2365)       !switch_to_saturated = PETSC_TRUE
  2366)       return
  2367)     endif
  2368)     one_plus_pc_alpha_n = 1.d0+pc_alpha_n
  2369)     Se = one_plus_pc_alpha_n**(-this%m)
  2370)     dSe_dpc = -this%m*n*this%alpha*pc_alpha_n/ &
  2371)             (pc_alpha*one_plus_pc_alpha_n**(this%m+1.d0))
  2372)     liquid_saturation = this%Sr + (1.d0-this%Sr)*Se
  2373)     dsat_dpres = -(1.d0-this%Sr)*dSe_dpc
  2374)   endif
  2375)   
  2376) end subroutine SF_VG_Saturation
  2377) ! End SF: van Genuchten
  2378) 
  2379) ! ************************************************************************** !
  2380) 
  2381) ! Begin SF: Brooks-Corey
  2382) function SF_BC_Create()
  2383) 
  2384)   ! Creates the Brooks Corey capillary pressure function object
  2385) 
  2386)   implicit none
  2387)   
  2388)   class(sat_func_BC_type), pointer :: SF_BC_Create
  2389)   
  2390)   allocate(SF_BC_Create)
  2391)   call SF_BC_Create%Init()
  2392)   
  2393) end function SF_BC_Create
  2394) 
  2395) ! ************************************************************************** !
  2396) 
  2397) subroutine SF_BC_Init(this)
  2398) 
  2399)   use Option_module
  2400) 
  2401)   implicit none
  2402)   
  2403)   class(sat_func_BC_type) :: this
  2404)   character(len=MAXWORDLENGTH) :: name
  2405)   type(option_type) :: option
  2406) 
  2407)   call SFBaseInit(this)
  2408)   this%alpha = UNINITIALIZED_DOUBLE
  2409)   this%lambda = UNINITIALIZED_DOUBLE
  2410)   
  2411) end subroutine SF_BC_Init
  2412) 
  2413) ! ************************************************************************** !
  2414) 
  2415) subroutine SF_BC_Verify(this,name,option)
  2416) 
  2417)   use Option_module
  2418) 
  2419)   implicit none
  2420)   
  2421)   class(sat_func_BC_type) :: this
  2422)   character(len=MAXSTRINGLENGTH) :: name
  2423)   type(option_type) :: option
  2424)   
  2425)   character(len=MAXSTRINGLENGTH) :: string 
  2426)   
  2427)   if (index(name,'SATURATION_FUNCTION') > 0) then
  2428)     string = name
  2429)   else
  2430)     string = trim(name) // 'SATURATION_FUNCTION,BROOKS_COREY'
  2431)   endif  
  2432)   call SFBaseVerify(this,string,option)
  2433)   if (Uninitialized(this%alpha)) then
  2434)     option%io_buffer = UninitializedMessage('ALPHA',string)
  2435)     call printErrMsg(option)
  2436)   endif 
  2437)   if (Uninitialized(this%lambda)) then
  2438)     option%io_buffer = UninitializedMessage('LAMBDA',string)
  2439)     call printErrMsg(option)
  2440)   endif 
  2441)   
  2442) end subroutine SF_BC_Verify
  2443) 
  2444) ! ************************************************************************** !
  2445) 
  2446) subroutine SF_BC_SetupPolynomials(this,option,error_string)
  2447) 
  2448)   ! Sets up polynomials for smoothing Brooks-Corey saturation function
  2449) 
  2450)   use Option_module
  2451)   use Utility_module
  2452)   
  2453)   implicit none
  2454)   
  2455)   class(sat_func_BC_type) :: this
  2456)   type(option_type) :: option
  2457)   character(len=MAXSTRINGLENGTH) :: error_string
  2458)   
  2459)   PetscReal :: b(4)
  2460) 
  2461)   ! polynomial fitting pc as a function of saturation
  2462)   ! 1.05 is essentially pc*alpha (i.e. pc = 1.05/alpha)
  2463)   this%sat_poly => PolynomialCreate()
  2464)   this%sat_poly%low = 1.05d0**(-this%lambda)
  2465)   this%sat_poly%high = 1.d0
  2466)   
  2467)   b = 0.d0
  2468)   ! fill right hand side
  2469)   ! capillary pressure at 1
  2470)   b(1) = 1.05d0/this%alpha 
  2471)   ! capillary pressure at 2
  2472)   b(2) = 0.d0
  2473)   ! derivative of pressure at saturation_1
  2474)   ! pc = Se**(-1/lambda)/alpha
  2475)   ! dpc_dSe = -1/lambda*Se**(-1/lambda-1)/alpha
  2476)   b(3) = -1.d0/this%lambda* &
  2477)           this%sat_poly%low**(-1.d0/this%lambda-1.d0)/ &
  2478)           this%alpha
  2479) 
  2480)   call QuadraticPolynomialSetup(this%sat_poly%low,this%sat_poly%high,b(1:3), &
  2481)                                 ! indicates derivative given at 1
  2482)                                 PETSC_TRUE) 
  2483)       
  2484)   this%sat_poly%coefficients(1:3) = b(1:3)
  2485) 
  2486)   ! polynomial fitting saturation as a function of pc
  2487)   !geh: cannot invert the pressure/saturation relationship above
  2488)   !     since it can result in saturations > 1 with both
  2489)   !     quadratic and cubic polynomials
  2490)   ! fill matix with values
  2491)   this%pres_poly => PolynomialCreate()
  2492)   this%pres_poly%low = 0.95/this%alpha
  2493)   this%pres_poly%high = 1.05/this%alpha
  2494)   
  2495)   b = 0.d0
  2496)   ! Se at 1
  2497)   b(1) = 1.d0
  2498)   ! Se at 2
  2499)   b(2) = (this%pres_poly%high*this%alpha)** &
  2500)           (-this%lambda)
  2501)   ! derivative of Se at 1
  2502)   b(3) = 0.d0 
  2503)   ! derivative of Se at 2
  2504)   b(4) = -this%lambda/this%pres_poly%high* &
  2505)             (this%pres_poly%high*this%alpha)** &
  2506)               (-this%lambda)
  2507) 
  2508)   call CubicPolynomialSetup(this%pres_poly%low,this%pres_poly%high,b)
  2509) 
  2510)   this%pres_poly%coefficients(1:4) = b(1:4)
  2511)   
  2512)   
  2513) end subroutine SF_BC_SetupPolynomials
  2514) 
  2515) ! ************************************************************************** !
  2516) 
  2517) subroutine SF_BC_CapillaryPressure(this,liquid_saturation, &
  2518)                                    capillary_pressure,option)
  2519)   ! 
  2520)   ! Computes the capillary_pressure as a function of saturation using the
  2521)   ! Brooks-Corey formulation
  2522)   ! 
  2523)   ! (1) Chen, J., J.W. Hopmans, M.E. Grismer (1999) "Parameter estimation of
  2524)   !     of two-fluid capillary pressure-saturation and permeability functions",
  2525)   !     Advances in Water Resources, Vol. 22, No. 5, pp 479-493,
  2526)   !     http://dx.doi.org/10.1016/S0309-1708(98)00025-6.
  2527)   !   
  2528)   ! Author: Glenn Hammond
  2529)   ! Date: 12/11/07, 09/23/14
  2530)   !
  2531)   use Option_module
  2532)   use Utility_module
  2533)   
  2534)   implicit none
  2535)   
  2536)   class(sat_func_BC_type) :: this
  2537)   PetscReal, intent(in) :: liquid_saturation
  2538)   PetscReal, intent(out) :: capillary_pressure
  2539)   type(option_type), intent(inout) :: option
  2540)   
  2541)   PetscReal :: Se
  2542)   PetscReal :: dummy_real
  2543)   
  2544)   if (liquid_saturation <= this%Sr) then
  2545)     capillary_pressure = this%pcmax
  2546)     return
  2547)   else if (liquid_saturation >= 1.d0) then
  2548)     capillary_pressure = 0.d0
  2549)     return
  2550)   endif
  2551)   
  2552)   Se = (liquid_saturation-this%Sr)/(1.d0-this%Sr)
  2553)   if (associated(this%sat_poly)) then
  2554)     if (Se > this%sat_poly%low) then
  2555)       call QuadraticPolynomialEvaluate(this%sat_poly%coefficients(1:3), &
  2556)                                        Se,capillary_pressure,dummy_real)
  2557)       return
  2558)     endif
  2559)   endif
  2560)   capillary_pressure = (Se**(-1.d0/this%lambda))/this%alpha
  2561) #if defined(MATCH_TOUGH2)
  2562)   if (liquid_saturation > 0.999d0) then
  2563)     capillary_pressure = capillary_pressure*(1.d0-liquid_saturation)/0.001d0
  2564)   endif
  2565) #endif  
  2566) 
  2567)   capillary_pressure = min(capillary_pressure,this%pcmax)
  2568)   
  2569) end subroutine SF_BC_CapillaryPressure
  2570) 
  2571) ! ************************************************************************** !
  2572) 
  2573) subroutine SF_BC_Saturation(this,capillary_pressure,liquid_saturation, &
  2574)                             dsat_dpres,option)
  2575)   ! 
  2576)   ! Computes the saturation (and associated derivatives) as a function of 
  2577)   ! capillary pressure
  2578)   ! 
  2579)   ! (1) Chen, J., J.W. Hopmans, M.E. Grismer (1999) "Parameter estimation of
  2580)   !     of two-fluid capillary pressure-saturation and permeability functions",
  2581)   !     Advances in Water Resources, Vol. 22, No. 5, pp 479-493,
  2582)   !     http://dx.doi.org/10.1016/S0309-1708(98)00025-6.
  2583)   !   
  2584)   ! Author: Glenn Hammond
  2585)   ! Date: 12/11/07, 09/23/14
  2586)     
  2587)   use Option_module
  2588)   use Utility_module
  2589)   
  2590)   implicit none
  2591) 
  2592)   class(sat_func_BC_type) :: this
  2593)   PetscReal, intent(in) :: capillary_pressure
  2594)   PetscReal, intent(out) :: liquid_saturation
  2595)   PetscReal, intent(out) :: dsat_dpres
  2596)   type(option_type), intent(inout) :: option
  2597)   
  2598)   PetscReal :: pc_alpha_neg_lambda
  2599)   PetscReal :: Se
  2600)   PetscReal :: dSe_dpc
  2601)   
  2602)   dsat_dpres = 0.d0
  2603)   
  2604)   ! reference #1
  2605)   if (associated(this%pres_poly)) then
  2606)     if (capillary_pressure < this%pres_poly%low) then
  2607)       liquid_saturation = 1.d0
  2608)       return
  2609)     else if (capillary_pressure < this%pres_poly%high) then
  2610)       call CubicPolynomialEvaluate(this%pres_poly%coefficients, &
  2611)                                    capillary_pressure,Se,dSe_dpc)
  2612)       liquid_saturation = this%Sr + (1.d0-this%Sr)*Se
  2613)       dsat_dpres = -(1.d0-this%Sr)*dSe_dpc
  2614)       return
  2615)     endif
  2616)   else
  2617)     if (capillary_pressure < 1.d0/this%alpha) then
  2618)       liquid_saturation = 1.d0
  2619)       dsat_dpres = 0.d0
  2620)       return
  2621)     endif
  2622)   endif
  2623) 
  2624)   pc_alpha_neg_lambda = (capillary_pressure*this%alpha)**(-this%lambda)
  2625)   Se = pc_alpha_neg_lambda
  2626)   dSe_dpc = -this%lambda/capillary_pressure*pc_alpha_neg_lambda
  2627)   liquid_saturation = this%Sr + (1.d0-this%Sr)*Se
  2628)   dsat_dpres = -(1.d0-this%Sr)*dSe_dpc
  2629)   
  2630) end subroutine SF_BC_Saturation
  2631) ! End SF: Brooks-Corey
  2632) 
  2633) ! ************************************************************************** !
  2634) 
  2635) ! Begin SF: Linear Model
  2636) function SF_Linear_Create()
  2637) 
  2638)   ! Creates the van Genutchten capillary pressure function object
  2639) 
  2640)   implicit none
  2641)   
  2642)   class(sat_func_Linear_type), pointer :: SF_Linear_Create
  2643)   
  2644)   allocate(SF_Linear_Create)
  2645)   call SF_Linear_Create%Init()
  2646)   
  2647) end function SF_Linear_Create
  2648) 
  2649) ! ************************************************************************** !
  2650) 
  2651) subroutine SF_Linear_Init(this)
  2652) 
  2653)   ! Creates the van Genutchten capillary pressure function object
  2654) 
  2655)   implicit none
  2656)   
  2657)   class(sat_func_Linear_type) :: this
  2658) 
  2659)   call SFBaseInit(this)
  2660)   this%alpha = UNINITIALIZED_DOUBLE
  2661)   
  2662) end subroutine SF_Linear_Init
  2663) 
  2664) ! ************************************************************************** !
  2665) 
  2666) subroutine SF_Linear_Verify(this,name,option)
  2667) 
  2668)   use Option_module
  2669)   
  2670)   implicit none
  2671)   
  2672)   class(sat_func_Linear_type) :: this
  2673)   character(len=MAXSTRINGLENGTH) :: name
  2674)   type(option_type) :: option
  2675)   
  2676)   character(len=MAXSTRINGLENGTH) :: string
  2677)   
  2678)   if (index(name,'SATURATION_FUNCTION') > 0) then
  2679)     string = name
  2680)   else
  2681)     string = trim(name) // 'SATURATION_FUNCTION,LINEAR'
  2682)   endif
  2683)   call SFBaseVerify(this,string,option)
  2684)   if (Uninitialized(this%alpha)) then
  2685)     option%io_buffer = UninitializedMessage('ALPHA',string)
  2686)     call printErrMsg(option)
  2687)   endif   
  2688) 
  2689) end subroutine SF_Linear_Verify
  2690) 
  2691) ! ************************************************************************** !
  2692) 
  2693) subroutine SF_Linear_CapillaryPressure(this,liquid_saturation, &
  2694)                                    capillary_pressure,option)
  2695)   ! 
  2696)   ! Computes the capillary_pressure as a function of saturation
  2697)   ! 
  2698)   !   
  2699) 
  2700)   ! Author: Bwalya Malama, Heeho Park
  2701)   ! Date: 11/14/14
  2702)   !
  2703)   use Option_module
  2704)   
  2705)   implicit none
  2706)   
  2707)   class(sat_func_Linear_type) :: this
  2708)   PetscReal, intent(in) :: liquid_saturation
  2709)   PetscReal, intent(out) :: capillary_pressure
  2710)   type(option_type), intent(inout) :: option
  2711)   
  2712)   PetscReal :: Se
  2713)   
  2714)   if (liquid_saturation <= this%Sr) then
  2715)     capillary_pressure = this%pcmax
  2716)     return
  2717)   else if (liquid_saturation >= 1.d0) then
  2718)     capillary_pressure = 0.d0
  2719)     return
  2720)   endif
  2721)   
  2722)   Se = (liquid_saturation-this%Sr)/(1.d0-this%Sr)
  2723)   capillary_pressure = (1.d0/this%alpha-this%pcmax)*Se + this%pcmax
  2724) #if defined(MATCH_TOUGH2)
  2725)   if (liquid_saturation > 0.999d0) then
  2726)     capillary_pressure = capillary_pressure*(1.d0-liquid_saturation)/0.001d0
  2727)   endif
  2728) #endif  
  2729) 
  2730)   capillary_pressure = min(capillary_pressure,this%pcmax)
  2731)   
  2732) end subroutine SF_Linear_CapillaryPressure
  2733) 
  2734) ! ************************************************************************** !
  2735) 
  2736) subroutine SF_Linear_Saturation(this,capillary_pressure,liquid_saturation, &
  2737)                             dsat_dpres,option)
  2738)   ! 
  2739)   ! Computes the saturation (and associated derivatives) as a function of 
  2740)   ! capillary pressure
  2741)   ! 
  2742)   !   
  2743)   ! Author: Bwalya Malama, Heeho Park
  2744)   ! Date: 11/14/14
  2745)   !
  2746)   use Option_module
  2747)   use Utility_module
  2748)   
  2749)   implicit none
  2750) 
  2751)   class(sat_func_Linear_type) :: this
  2752)   PetscReal, intent(in) :: capillary_pressure
  2753)   PetscReal, intent(out) :: liquid_saturation
  2754)   PetscReal, intent(out) :: dsat_dpres
  2755)   type(option_type), intent(inout) :: option
  2756)   
  2757)   PetscReal :: Se
  2758)   PetscReal :: dSe_dpc
  2759)   
  2760)   dsat_dpres = 0.d0
  2761) 
  2762)   if (capillary_pressure <= 0.d0) then
  2763)     liquid_saturation = 1.d0
  2764)     return
  2765)   else
  2766)     Se = (this%pcmax-capillary_pressure) / (this%pcmax-1.d0/this%alpha)
  2767)     dSe_dpc = -1.d0/(this%pcmax-1.d0/this%alpha)
  2768)     liquid_saturation = this%Sr + (1.d0-this%Sr)*Se
  2769)     dsat_dpres = -(1.d0-this%Sr)*dSe_dpc
  2770)   endif 
  2771) 
  2772) end subroutine SF_Linear_Saturation
  2773) ! End SF: Linear Model
  2774) 
  2775) ! ************************************************************************** !
  2776) 
  2777) ! Begin SF: BRAGFLO KRP9 Model
  2778) function SF_BF_KRP9_Create()
  2779) 
  2780)   ! Creates the van Genutchten capillary pressure function object
  2781) 
  2782)   implicit none
  2783)   
  2784)   class(sat_func_BF_KRP9_type), pointer :: SF_BF_KRP9_Create
  2785)   
  2786)   allocate(SF_BF_KRP9_Create)
  2787)   call SF_BF_KRP9_Create%Init()
  2788)   
  2789) end function SF_BF_KRP9_Create
  2790) 
  2791) ! ************************************************************************** !
  2792) 
  2793) subroutine SF_BF_KRP9_Init(this)
  2794) 
  2795)   ! Creates the van Genutchten capillary pressure function object
  2796) 
  2797)   implicit none
  2798)   
  2799)   class(sat_func_BF_KRP9_type) :: this
  2800) 
  2801)   call SFBaseInit(this)
  2802)   
  2803) end subroutine SF_BF_KRP9_Init
  2804) 
  2805) ! ************************************************************************** !
  2806) 
  2807) subroutine SF_BF_KRP9_Verify(this,name,option)
  2808) 
  2809)   use Option_module
  2810)   
  2811)   implicit none
  2812)   
  2813)   class(sat_func_BF_KRP9_type) :: this
  2814)   character(len=MAXSTRINGLENGTH) :: name
  2815)   type(option_type) :: option
  2816)   
  2817)   character(len=MAXSTRINGLENGTH) :: string
  2818)   
  2819)   if (index(name,'SATURATION_FUNCTION') > 0) then
  2820)     string = name
  2821)   else
  2822)     string = trim(name) // 'SATURATION_FUNCTION,BRAGFLO_KRP9'
  2823)   endif
  2824)   call SFBaseVerify(this,string,option)
  2825) 
  2826) end subroutine SF_BF_KRP9_Verify
  2827) 
  2828) ! ************************************************************************** !
  2829) 
  2830) subroutine SF_BF_KRP9_CapillaryPressure(this,liquid_saturation, &
  2831)                                    capillary_pressure,option)
  2832)   ! 
  2833)   ! Computes the capillary_pressure as a function of saturation
  2834)   ! based on experimental measurements and analyses done by Vauclin et al.
  2835)   ! as discussed by Moridis and Pruess.  
  2836)   ! 14.	Moridis, G. J., and K. Pruess.  1992.  TOUGH Simulations of 
  2837)   ! Updegraff\92s Set of Fluid and Heat Flow Problems.  LBL-32611, ERMS# 138458. 
  2838)   ! Berkeley, CA:  Lawrence Berkeley Laboratory.
  2839)   ! Author: Heeho Park
  2840)   ! Date: 03/26/15
  2841)   !
  2842)   use Option_module
  2843)   
  2844)   implicit none
  2845)   
  2846)   class(sat_func_BF_KRP9_type) :: this
  2847)   PetscReal, intent(in) :: liquid_saturation
  2848)   PetscReal, intent(out) :: capillary_pressure
  2849)   type(option_type), intent(inout) :: option
  2850)   
  2851)   PetscReal :: Se
  2852)   
  2853)   if (liquid_saturation <= this%Sr) then
  2854)     capillary_pressure = 0.d0
  2855)     return
  2856)   else if (liquid_saturation >= 1.d0) then
  2857)     capillary_pressure = 0.d0
  2858)     return
  2859)   endif
  2860)   
  2861)   Se = (1.d0-liquid_saturation)/(liquid_saturation)
  2862)   capillary_pressure = 3783.0145d0*Se**(1.d0/2.9d0)
  2863) #if defined(MATCH_TOUGH2)
  2864)   if (liquid_saturation > 0.999d0) then
  2865)     capillary_pressure = capillary_pressure*(1.d0-liquid_saturation)/0.001d0
  2866)   endif
  2867) #endif
  2868) 
  2869) !  capillary_pressure = min(capillary_pressure,this%pcmax)
  2870)   
  2871) end subroutine SF_BF_KRP9_CapillaryPressure
  2872) 
  2873) ! ************************************************************************** !
  2874) 
  2875) subroutine SF_BF_KRP9_Saturation(this,capillary_pressure,liquid_saturation, &
  2876)                             dsat_dpres,option)
  2877)   ! 
  2878)   ! Computes the saturation (and associated derivatives) as a function of 
  2879)   ! capillary pressure
  2880)   ! 
  2881)   !   
  2882)   ! Author: Heeho Park
  2883)   ! Date: 03/26/15
  2884)   !
  2885)   use Option_module
  2886)   use Utility_module
  2887)   
  2888)   implicit none
  2889) 
  2890)   class(sat_func_BF_KRP9_type) :: this
  2891)   PetscReal, intent(in) :: capillary_pressure
  2892)   PetscReal, intent(out) :: liquid_saturation
  2893)   PetscReal, intent(out) :: dsat_dpres
  2894)   type(option_type), intent(inout) :: option
  2895)   
  2896)   PetscReal :: Se
  2897)   PetscReal :: dSe_dpc
  2898)   
  2899)   dsat_dpres = 0.d0
  2900) 
  2901)   if (capillary_pressure <= 0.d0) then
  2902)     liquid_saturation = 1.d0
  2903)     return
  2904)   else
  2905)     Se = (capillary_pressure/3783.0145d0)**(2.9d0)
  2906)     liquid_saturation = 1.d0 / (Se-1.d0)
  2907)   endif 
  2908) 
  2909) end subroutine SF_BF_KRP9_Saturation
  2910) ! End SF: BRAGFLO KRP9 Model
  2911) 
  2912) ! ************************************************************************** !
  2913) 
  2914) ! Begin SF: BRAGFLO KRP4 Model
  2915) 
  2916) function SF_BF_KRP4_Create()
  2917) 
  2918)   ! Creates the van Genutchten capillary pressure function object
  2919) 
  2920)   implicit none
  2921)   
  2922)   class(sat_func_BF_KRP4_type), pointer :: SF_BF_KRP4_Create
  2923)   
  2924)   allocate(SF_BF_KRP4_Create)
  2925)   call SF_BF_KRP4_Create%Init()
  2926)   
  2927) end function SF_BF_KRP4_Create
  2928) 
  2929) ! ************************************************************************** !
  2930) 
  2931) subroutine SF_BF_KRP4_Verify(this,name,option)
  2932) 
  2933)   use Option_module
  2934) 
  2935)   implicit none
  2936)   
  2937)   class(sat_func_BF_KRP4_type) :: this
  2938)   character(len=MAXSTRINGLENGTH) :: name
  2939)   type(option_type) :: option
  2940)   
  2941)   character(len=MAXSTRINGLENGTH) :: string 
  2942)   
  2943)   if (index(name,'SATURATION_FUNCTION') > 0) then
  2944)     string = name
  2945)   else
  2946)     string = trim(name) // 'SATURATION_FUNCTION,BROOKS_COREY'
  2947)   endif  
  2948)   call SFBaseVerify(this,string,option)
  2949)   if (Uninitialized(this%alpha)) then
  2950)     option%io_buffer = UninitializedMessage('ALPHA',string)
  2951)     call printErrMsg(option)
  2952)   endif 
  2953)   if (Uninitialized(this%lambda)) then
  2954)     option%io_buffer = UninitializedMessage('LAMBDA',string)
  2955)     call printErrMsg(option)
  2956)   endif 
  2957)   if (Uninitialized(this%Srg)) then
  2958)     option%io_buffer = UninitializedMessage('Srg',string)
  2959)     call printErrMsg(option)
  2960)   endif 
  2961)   if (Uninitialized(this%pcmax_flag)) then
  2962)     option%io_buffer = UninitializedMessage('KPC',string)
  2963)     call printErrMsg(option)
  2964)   endif 
  2965)   
  2966) end subroutine SF_BF_KRP4_Verify
  2967)   
  2968) ! ************************************************************************** !
  2969) 
  2970) subroutine SF_BF_KRP4_CapillaryPressure(this,liquid_saturation, &
  2971)                                    capillary_pressure,option)
  2972)   ! 
  2973)   ! Computes the capillary_pressure as a function of saturation using the
  2974)   ! Brooks-Corey formulation
  2975)   ! 
  2976)   ! Modified according to KRP=4 option of BRAGFLO
  2977)   ! Explanation: residual gas saturation in the calculation of effective 
  2978)   ! saturation
  2979)   ! There is no usage of Pc Max unless KPC card is defined as 2. If KPC = 0,
  2980)   ! then there is no cut off in Pc Max
  2981)   ! Author: Heeho Park
  2982)   ! Date: 11/14/15
  2983)   !
  2984)   use Option_module
  2985)   use Utility_module
  2986)   
  2987)   implicit none
  2988)   
  2989)   class(sat_func_BF_KRP4_type) :: this
  2990)   PetscReal, intent(in) :: liquid_saturation
  2991)   PetscReal, intent(out) :: capillary_pressure
  2992)   type(option_type), intent(inout) :: option
  2993)   
  2994)   PetscReal :: Se
  2995)   PetscReal :: dummy_real
  2996)   
  2997)   if (liquid_saturation >= 1.d0) then
  2998)     capillary_pressure = 0.d0
  2999)     return
  3000)   endif
  3001)   
  3002)   if (this%alpha > 1.0d20) then
  3003)     capillary_pressure = 0.d0
  3004)     return
  3005)   endif
  3006) 
  3007)   Se = (liquid_saturation-this%Sr)/(1.d0-this%Sr-this%Srg)
  3008)   
  3009)   if (Se > 1.d0) then
  3010)      Se = 1.d0
  3011)   else if (Se < 0.d0) then
  3012)      Se = 0.d0
  3013)   endif
  3014) 
  3015)   if (associated(this%sat_poly)) then
  3016)     if (Se > this%sat_poly%low) then
  3017)       call QuadraticPolynomialEvaluate(this%sat_poly%coefficients(1:3), &
  3018)                                        Se,capillary_pressure,dummy_real)
  3019)       return
  3020)     endif
  3021)   endif
  3022) 
  3023)   capillary_pressure = (Se**(-1.d0/this%lambda))/this%alpha
  3024)   
  3025)   if (this%pcmax_flag == 2) then
  3026)     capillary_pressure = min(capillary_pressure,this%pcmax)
  3027)   endif
  3028) 
  3029) end subroutine SF_BF_KRP4_CapillaryPressure
  3030) 
  3031) ! ************************************************************************** !
  3032) 
  3033) subroutine SF_BF_KRP4_Saturation(this,capillary_pressure,liquid_saturation, &
  3034)                             dsat_dpres,option)
  3035)   ! 
  3036)   ! Computes the capillary_pressure as a function of saturation using the
  3037)   ! Brooks-Corey formulation
  3038)   ! 
  3039)   ! Modified according to KRP=4 option of BRAGFLO
  3040)   ! Explanation: residual gas saturation in the calculation of effective 
  3041)   ! saturation
  3042)   ! There is no usage of Pc Max unless KPC card is defined as 2. If KPC = 0,
  3043)   ! then there is no cut off in Pc Max
  3044)   ! Author: Heeho Park
  3045)   ! Date: 11/14/15
  3046)   ! 
  3047)   use Option_module
  3048)   use Utility_module
  3049)   
  3050)   implicit none
  3051) 
  3052)   class(sat_func_BF_KRP4_type) :: this
  3053)   PetscReal, intent(in) :: capillary_pressure
  3054)   PetscReal, intent(out) :: liquid_saturation
  3055)   PetscReal, intent(out) :: dsat_dpres
  3056)   type(option_type), intent(inout) :: option
  3057)   
  3058)   PetscReal :: pc_alpha_neg_lambda
  3059)   PetscReal :: Se
  3060)   PetscReal :: dSe_dpc
  3061)   
  3062)   dsat_dpres = 0.d0
  3063)   
  3064)   ! reference #1
  3065)   if (associated(this%pres_poly)) then
  3066)     if (capillary_pressure < this%pres_poly%low) then
  3067)       liquid_saturation = 1.d0
  3068)       return
  3069)     else if (capillary_pressure < this%pres_poly%high) then
  3070)       call CubicPolynomialEvaluate(this%pres_poly%coefficients, &
  3071)                                    capillary_pressure,Se,dSe_dpc)
  3072)       liquid_saturation = this%Sr + (1.d0-this%Sr-this%Srg)*Se
  3073)       dsat_dpres = -(1.d0-this%Sr)*dSe_dpc
  3074)       return
  3075)     endif
  3076)   else
  3077)     if (capillary_pressure < 1.d0/this%alpha) then
  3078)       liquid_saturation = 1.d0
  3079)       dsat_dpres = 0.d0
  3080)       return
  3081)     endif
  3082)   endif
  3083) 
  3084)   pc_alpha_neg_lambda = (capillary_pressure*this%alpha)**(-this%lambda)
  3085)   Se = pc_alpha_neg_lambda
  3086)   dSe_dpc = -this%lambda/capillary_pressure*pc_alpha_neg_lambda
  3087)   liquid_saturation = this%Sr + (1.d0-this%Sr-this%Srg)*Se
  3088)   dsat_dpres = -(1.d0-this%Sr)*dSe_dpc
  3089)   
  3090) end subroutine SF_BF_KRP4_Saturation
  3091) 
  3092) ! End SF: BRAGFLO KRP4 Model
  3093) 
  3094) ! ************************************************************************** !
  3095) ! Begin SF: BRAGFLO KRP11 Model
  3096) function SF_BF_KRP11_Create()
  3097) 
  3098)   ! Creates the van Genutchten capillary pressure function object
  3099) 
  3100)   implicit none
  3101)   
  3102)   class(sat_func_BF_KRP11_type), pointer :: SF_BF_KRP11_Create
  3103)   
  3104)   allocate(SF_BF_KRP11_Create)
  3105)   call SF_BF_KRP11_Create%Init()
  3106)   
  3107) end function SF_BF_KRP11_Create
  3108) 
  3109) ! ************************************************************************** !
  3110) 
  3111) subroutine SF_BF_KRP11_Init(this)
  3112) 
  3113)   ! Creates the van Genutchten capillary pressure function object
  3114) 
  3115)   implicit none
  3116)   
  3117)   class(sat_func_BF_KRP11_type) :: this
  3118) 
  3119)   call SFBaseInit(this)
  3120)   
  3121) end subroutine SF_BF_KRP11_Init
  3122) 
  3123) ! ************************************************************************** !
  3124) 
  3125) subroutine SF_BF_KRP11_Verify(this,name,option)
  3126) 
  3127)   use Option_module
  3128)   
  3129)   implicit none
  3130)   
  3131)   class(sat_func_BF_KRP11_type) :: this
  3132)   character(len=MAXSTRINGLENGTH) :: name
  3133)   type(option_type) :: option
  3134)   
  3135)   character(len=MAXSTRINGLENGTH) :: string
  3136)   
  3137)   if (index(name,'SATURATION_FUNCTION') > 0) then
  3138)     string = name
  3139)   else
  3140)     string = trim(name) // 'SATURATION_FUNCTION,BRAGFLO_KRP11'
  3141)   endif
  3142)   call SFBaseVerify(this,string,option)
  3143) 
  3144) end subroutine SF_BF_KRP11_Verify
  3145) 
  3146) ! ************************************************************************** !
  3147) 
  3148) subroutine SF_BF_KRP11_CapillaryPressure(this,liquid_saturation, &
  3149)                                    capillary_pressure,option)
  3150)   ! 
  3151)   ! KRP=11 of BRAGFLO
  3152)   ! capillary pressure is 0 at all times
  3153)   ! Author: Heeho Park
  3154)   ! Date: 03/26/15
  3155)   !
  3156)   use Option_module
  3157)   
  3158)   implicit none
  3159)   
  3160)   class(sat_func_BF_KRP11_type) :: this
  3161)   PetscReal, intent(in) :: liquid_saturation
  3162)   PetscReal, intent(out) :: capillary_pressure
  3163)   type(option_type), intent(inout) :: option
  3164) 
  3165)   capillary_pressure = 0.0d0
  3166)   
  3167) end subroutine SF_BF_KRP11_CapillaryPressure
  3168) 
  3169) ! ************************************************************************** !
  3170) 
  3171) subroutine SF_BF_KRP11_Saturation(this,capillary_pressure,liquid_saturation, &
  3172)                             dsat_dpres,option)
  3173)   ! 
  3174)   ! Computes the saturation (and associated derivatives) as a function of 
  3175)   ! capillary pressure
  3176)   ! 
  3177)   !   
  3178)   ! Author: Heeho Park
  3179)   ! Date: 03/26/15
  3180)   !
  3181)   use Option_module
  3182)   use Utility_module
  3183)   
  3184)   implicit none
  3185) 
  3186)   class(sat_func_BF_KRP11_type) :: this
  3187)   PetscReal, intent(in) :: capillary_pressure
  3188)   PetscReal, intent(out) :: liquid_saturation
  3189)   PetscReal, intent(out) :: dsat_dpres
  3190)   type(option_type), intent(inout) :: option
  3191)   
  3192)   PetscReal :: Se
  3193)   PetscReal :: dSe_dpc
  3194)   
  3195)   dsat_dpres = 0.d0
  3196) 
  3197)   liquid_saturation = 1.d0
  3198) 
  3199) end subroutine SF_BF_KRP11_Saturation
  3200) ! End SF: BRAGFLO KRP11 Model
  3201) 
  3202) ! ************************************************************************** !
  3203) 
  3204) ! Begin SF: BRAGFLO KRP12 Model
  3205) 
  3206) function SF_BF_KRP12_Create()
  3207) 
  3208)   ! Creates the van Genutchten capillary pressure function object
  3209) 
  3210)   implicit none
  3211)   
  3212)   class(sat_func_BF_KRP12_type), pointer :: SF_BF_KRP12_Create
  3213)   
  3214)   allocate(SF_BF_KRP12_Create)
  3215)   call SF_BF_KRP12_Create%Init()
  3216)   
  3217) end function SF_BF_KRP12_Create
  3218) 
  3219) ! ************************************************************************** !
  3220) 
  3221) subroutine SF_BF_KRP12_Verify(this,name,option)
  3222) 
  3223)   use Option_module
  3224) 
  3225)   implicit none
  3226)   
  3227)   class(sat_func_BF_KRP12_type) :: this
  3228)   character(len=MAXSTRINGLENGTH) :: name
  3229)   type(option_type) :: option
  3230)   
  3231)   character(len=MAXSTRINGLENGTH) :: string 
  3232)   
  3233)   if (index(name,'SATURATION_FUNCTION') > 0) then
  3234)     string = name
  3235)   else
  3236)     string = trim(name) // 'SATURATION_FUNCTION,BROOKS_COREY'
  3237)   endif  
  3238)   call SFBaseVerify(this,string,option)
  3239)   if (Uninitialized(this%socmin)) then
  3240)     option%io_buffer = UninitializedMessage('ALPHA',string)
  3241)     call printErrMsg(option)
  3242)   endif 
  3243)   if (Uninitialized(this%soceffmin)) then
  3244)     option%io_buffer = UninitializedMessage('LAMBDA',string)
  3245)     call printErrMsg(option)
  3246)   endif 
  3247)   if (Uninitialized(this%Srg)) then
  3248)     option%io_buffer = UninitializedMessage('Srg',string)
  3249)     call printErrMsg(option)
  3250)   endif 
  3251)   
  3252) end subroutine SF_BF_KRP12_Verify
  3253) ! ************************************************************************** !
  3254) 
  3255) subroutine SF_BF_KRP12_CapillaryPressure(this,liquid_saturation, &
  3256)                                    capillary_pressure,option)
  3257)   ! 
  3258)   ! Computes the capillary_pressure as a function of saturation using the
  3259)   ! Brooks-Corey formulation
  3260)   ! 
  3261)   ! Modified according to KRP=12 option of BRAGFLO
  3262)   ! Explanation: The relative permeabilities are unchanged from the 
  3263)   ! modified Brooks-Corey model but the capillary presssure is 
  3264)   ! calculated with modified saturation
  3265)   ! Author: Heeho Park
  3266)   ! Date: 11/14/15
  3267)   !
  3268)   use Option_module
  3269)   use Utility_module
  3270)   
  3271)   implicit none
  3272)   
  3273)   class(sat_func_BF_KRP12_type) :: this
  3274)   PetscReal, intent(in) :: liquid_saturation
  3275)   PetscReal, intent(out) :: capillary_pressure
  3276)   type(option_type), intent(inout) :: option
  3277)   
  3278)   PetscReal :: Se
  3279)   PetscReal :: dummy_real
  3280)   PetscReal :: soczro
  3281)   
  3282)   soczro = this%socmin - this%soceffmin
  3283)   
  3284)   if (liquid_saturation >= 1.d0) then
  3285)     capillary_pressure = 0.d0
  3286)     return
  3287)   endif
  3288)   
  3289)   if (this%alpha > 1.0d20) then
  3290)     capillary_pressure = 0.d0
  3291)     return
  3292)   endif
  3293) 
  3294)   Se = (liquid_saturation-soczro)/(1.d0-soczro)
  3295)   Se = max(min(Se,1.0d0),this%soceffmin)
  3296)   
  3297)   if (associated(this%sat_poly)) then
  3298)     if (Se > this%sat_poly%low) then
  3299)       call QuadraticPolynomialEvaluate(this%sat_poly%coefficients(1:3), &
  3300)                                        Se,capillary_pressure,dummy_real)
  3301)       return
  3302)     endif
  3303)   endif
  3304) 
  3305)   capillary_pressure = (Se**(-1.d0/this%lambda))/this%alpha
  3306) 
  3307) end subroutine SF_BF_KRP12_CapillaryPressure
  3308) 
  3309) ! End SF: BRAGFLO KRP12 Model  
  3310) 
  3311) ! ************************************************************************** !
  3312) 
  3313) ! Begin RPF: Mualem, Van Genuchten (Liquid)
  3314) function RPF_Mualem_VG_Liq_Create()
  3315) 
  3316)   ! Creates the van Genutchten Mualem relative permeability function object
  3317) 
  3318)   implicit none
  3319)   
  3320)   class(rpf_Mualem_vg_liq_type), pointer :: RPF_Mualem_VG_Liq_Create
  3321)   
  3322)   allocate(RPF_Mualem_VG_Liq_Create)
  3323)   call RPF_Mualem_VG_Liq_Create%Init()
  3324)   
  3325) end function RPF_Mualem_VG_Liq_Create
  3326) 
  3327) ! ************************************************************************** !
  3328) 
  3329) subroutine RPF_Mualem_VG_Liq_Init(this)
  3330) 
  3331)   ! Initializes the van Genutchten Mualem relative permeability function 
  3332)   ! object
  3333) 
  3334)   implicit none
  3335)   
  3336)   class(rpf_Mualem_VG_liq_type) :: this
  3337) 
  3338)   call RPFBaseInit(this)
  3339)   this%m = UNINITIALIZED_DOUBLE
  3340)   
  3341) end subroutine RPF_Mualem_VG_Liq_Init
  3342) 
  3343) ! ************************************************************************** !
  3344) 
  3345) subroutine RPF_Mualem_VG_Liq_Verify(this,name,option)
  3346) 
  3347)   use Option_module
  3348) 
  3349)   implicit none
  3350)   
  3351)   class(rpf_Mualem_VG_liq_type) :: this
  3352)   character(len=MAXSTRINGLENGTH) :: name
  3353)   type(option_type) :: option
  3354)   
  3355)   character(len=MAXSTRINGLENGTH) :: string
  3356)   
  3357)   if (index(name,'PERMEABILITY_FUNCTION') > 0) then
  3358)     string = name
  3359)   else
  3360)     string = trim(name) // 'PERMEABILITY_FUNCTION,MUALEM'
  3361)   endif  
  3362)   call RPFBaseVerify(this,string,option)
  3363)   if (Uninitialized(this%m)) then
  3364)     option%io_buffer = UninitializedMessage('M',string)
  3365)     call printErrMsg(option)
  3366)   endif   
  3367)   
  3368) end subroutine RPF_Mualem_VG_Liq_Verify
  3369) 
  3370) ! ************************************************************************** !
  3371) 
  3372) subroutine RPF_Mualem_SetupPolynomials(this,option,error_string)
  3373) 
  3374)   ! Sets up polynomials for smoothing Mualem permeability function
  3375) 
  3376)   use Option_module
  3377)   use Utility_module
  3378)   
  3379)   implicit none
  3380)   
  3381)   class(rpf_Mualem_VG_liq_type) :: this
  3382)   type(option_type) :: option
  3383)   character(len=MAXSTRINGLENGTH) :: error_string
  3384)   
  3385)   PetscReal :: b(4)
  3386)   PetscReal :: one_over_m, Se_one_over_m, m
  3387) 
  3388)   this%poly => PolynomialCreate()
  3389)   ! fill matix with values
  3390)   this%poly%low = 0.99d0  ! just below saturated
  3391)   this%poly%high = 1.d0   ! saturated
  3392)   
  3393)   m = this%m
  3394)   one_over_m = 1.d0/m
  3395)   Se_one_over_m = this%poly%low**one_over_m
  3396)   b(1) = 1.d0
  3397)   b(2) = sqrt(this%poly%low)*(1.d0-(1.d0-Se_one_over_m)**m)**2.d0
  3398)   b(3) = 0.d0
  3399)   b(4) = 0.5d0*b(2)/this%poly%low+ &
  3400)           2.d0*this%poly%low**(one_over_m-0.5d0)* &
  3401)           (1.d0-Se_one_over_m)**(m-1.d0)* &
  3402)           (1.d0-(1.d0-Se_one_over_m)**m)
  3403)   
  3404)   call CubicPolynomialSetup(this%poly%high,this%poly%low,b)
  3405)   
  3406)   this%poly%coefficients(1:4) = b(1:4)
  3407)   
  3408) end subroutine RPF_Mualem_SetupPolynomials
  3409) 
  3410) ! ************************************************************************** !
  3411) 
  3412) subroutine RPF_Mualem_VG_Liq_RelPerm(this,liquid_saturation, &
  3413)                               relative_permeability,dkr_sat,option)
  3414)   ! 
  3415)   ! Computes the relative permeability (and associated derivatives) as a 
  3416)   ! function of saturation
  3417)   ! 
  3418)   ! (1) Chen, J., J.W. Hopmans, M.E. Grismer (1999) "Parameter estimation of
  3419)   !     of two-fluid capillary pressure-saturation and permeability functions",
  3420)   !     Advances in Water Resources, Vol. 22, No. 5, pp 479-493,
  3421)   !     http://dx.doi.org/10.1016/S0309-1708(98)00025-6.
  3422)   !   
  3423)   ! Author: Glenn Hammond
  3424)   ! Date: 12/11/07, 09/23/14
  3425)   ! 
  3426)   use Option_module
  3427)   use Utility_module
  3428)   
  3429)   implicit none
  3430) 
  3431)   class(rpf_Mualem_VG_liq_type) :: this
  3432)   PetscReal, intent(in) :: liquid_saturation
  3433)   PetscReal, intent(out) :: relative_permeability
  3434)   PetscReal, intent(out) :: dkr_sat
  3435)   type(option_type), intent(inout) :: option
  3436)   
  3437)   PetscReal :: Se
  3438)   PetscReal :: one_over_m
  3439)   PetscReal :: Se_one_over_m
  3440)   PetscReal :: dkr_Se
  3441)   PetscReal :: dSe_sat
  3442) 
  3443)   relative_permeability = 0.d0
  3444)   dkr_sat = 0.d0
  3445)   
  3446)   Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr)
  3447)   if (Se >= 1.d0) then
  3448)     relative_permeability = 1.d0
  3449)     return
  3450)   else if (Se <= 0.d0) then
  3451)     relative_permeability = 0.d0
  3452)     return
  3453)   endif
  3454)   
  3455)   if (associated(this%poly)) then
  3456)     if (Se > this%poly%low) then
  3457)       call CubicPolynomialEvaluate(this%poly%coefficients, &
  3458)                                    Se,relative_permeability,dkr_Se)
  3459)       return
  3460)     endif
  3461)   endif
  3462)   
  3463)   one_over_m = 1.d0/this%m
  3464)   Se_one_over_m = Se**one_over_m
  3465)   relative_permeability = sqrt(Se)*(1.d0-(1.d0-Se_one_over_m)**this%m)**2.d0
  3466)   dkr_Se = 0.5d0*relative_permeability/Se+ &
  3467)             2.d0*Se**(one_over_m-0.5d0)* &
  3468)                 (1.d0-Se_one_over_m)**(this%m-1.d0)* &
  3469)                 (1.d0-(1.d0-Se_one_over_m)**this%m)
  3470)   dSe_sat = 1.d0 / (1.d0 - this%Sr)
  3471)   dkr_sat = dkr_Se * dSe_sat
  3472)   
  3473) end subroutine RPF_Mualem_VG_Liq_RelPerm
  3474) ! End RPF: Mualem, Van Genuchten (Liquid)
  3475) 
  3476) ! ************************************************************************** !
  3477) 
  3478) ! Begin RPF: Mualem, Van Genuchten (Gas)
  3479) function RPF_Mualem_VG_Gas_Create()
  3480) 
  3481)   ! Creates the van Genutchten Mualem gas relative permeability function object
  3482) 
  3483)   implicit none
  3484)   
  3485)   class(rpf_Mualem_VG_gas_type), pointer :: RPF_Mualem_VG_Gas_Create
  3486)   
  3487)   allocate(RPF_Mualem_VG_Gas_Create)
  3488)   call RPF_Mualem_VG_Gas_Create%Init()
  3489)   
  3490) end function RPF_Mualem_VG_Gas_Create
  3491) 
  3492) ! ************************************************************************** !
  3493) 
  3494) subroutine RPF_Mualem_VG_Gas_Init(this)
  3495) 
  3496)   ! Initializes the van Genutchten Mualem gas relative permeability function 
  3497)   ! object
  3498) 
  3499)   implicit none
  3500)   
  3501)   class(rpf_Mualem_VG_gas_type) :: this
  3502) 
  3503)   call RPFBaseInit(this)
  3504)   this%Srg = UNINITIALIZED_DOUBLE
  3505)   
  3506) end subroutine RPF_Mualem_VG_Gas_Init
  3507) 
  3508) ! ************************************************************************** !
  3509) 
  3510) subroutine RPF_Mualem_VG_Gas_Verify(this,name,option)
  3511) 
  3512)   use Option_module
  3513)   
  3514)   implicit none
  3515)   
  3516)   class(rpf_Mualem_VG_gas_type) :: this
  3517)   character(len=MAXSTRINGLENGTH) :: name
  3518)   type(option_type) :: option
  3519)   
  3520)   character(len=MAXSTRINGLENGTH) :: string
  3521)   
  3522)   if (index(name,'PERMEABILITY_FUNCTION') > 0) then
  3523)     string = name
  3524)   else
  3525)     string = trim(name) // 'PERMEABILITY_FUNCTION,MUALEM_VG_GAS'
  3526)   endif  
  3527)   call RPFBaseVerify(this,string,option)
  3528)   if (Uninitialized(this%Srg)) then
  3529)     option%io_buffer = UninitializedMessage('GAS_RESIDUAL_SATURATION',string)
  3530)     call printErrMsg(option)
  3531)   endif 
  3532)   
  3533) end subroutine RPF_Mualem_VG_Gas_Verify
  3534) 
  3535) ! ************************************************************************** !
  3536) 
  3537) subroutine RPF_Mualem_VG_Gas_RelPerm(this,liquid_saturation, &
  3538)                                      relative_permeability,dkr_sat,option)
  3539)   ! 
  3540)   ! Computes the relative permeability (and associated derivatives) as a 
  3541)   ! function of saturation
  3542)   ! 
  3543)   ! (1) Chen, J., J.W. Hopmans, M.E. Grismer (1999) "Parameter estimation of
  3544)   !     of two-fluid capillary pressure-saturation and permeability functions",
  3545)   !     Advances in Water Resources, Vol. 22, No. 5, pp 479-493,
  3546)   !     http://dx.doi.org/10.1016/S0309-1708(98)00025-6.
  3547)   !   
  3548)   ! Author: Glenn Hammond
  3549)   ! Date: 12/11/07, 09/23/14
  3550)   ! 
  3551)   use Option_module
  3552)   
  3553)   implicit none
  3554) 
  3555)   class(rpf_Mualem_VG_gas_type) :: this
  3556)   PetscReal, intent(in) :: liquid_saturation
  3557)   PetscReal, intent(out) :: relative_permeability
  3558)   PetscReal, intent(out) :: dkr_sat
  3559)   type(option_type), intent(inout) :: option
  3560)   
  3561)   PetscReal :: Se
  3562)   PetscReal :: Seg
  3563)   PetscReal :: dkr_Se
  3564)   PetscReal :: dSe_sat
  3565)   
  3566)   Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr - this%Srg)
  3567)   
  3568)   relative_permeability = 0.d0
  3569)   dkr_sat = UNINITIALIZED_DOUBLE
  3570)   if (Se >= 1.d0) then
  3571)     relative_permeability = 0.d0
  3572)     return
  3573)   else if (Se <=  0.d0) then
  3574)     relative_permeability = 1.d0
  3575)     return
  3576)   endif
  3577)   
  3578)   Seg = 1.d0 - Se
  3579)   relative_permeability = sqrt(Seg)*(1.d0-Se**(1.d0/this%m))**(2.d0*this%m)
  3580)   ! Mathematica Analytical solution (Heeho Park)
  3581)   dkr_Se = -(1.d0-Se**(1.d0/this%m))**(2.d0*this%m)/(2.d0*sqrt(Seg)) &
  3582)           - 2.d0*sqrt(Seg)*Se**(1.d0/this%m-1.d0) &
  3583)           * (1.d0-Se**(1.d0/this%m))**(2.d0*this%m-1.d0)
  3584)   dSe_sat = 1.d0 / (1.d0 - this%Sr - this%Srg)
  3585)   dkr_sat = dkr_Se * dSe_sat
  3586)   
  3587) end subroutine RPF_Mualem_VG_Gas_RelPerm
  3588) ! End RPF: Mualem, Van Genuchten (Gas)
  3589) 
  3590) ! ************************************************************************** !
  3591) 
  3592) ! RPF: Tough2 IRP7 w/ VG-Mualem (Gas)
  3593) function RPF_TOUGH2_IRP7_Gas_Create()
  3594) 
  3595)   ! Creates the Brooks-Corey Burdine gas relative permeability function object
  3596) 
  3597)   implicit none
  3598)   
  3599)   class(rpf_TOUGH2_IRP7_gas_type), pointer :: RPF_TOUGH2_IRP7_Gas_Create
  3600)   
  3601)   allocate(RPF_TOUGH2_IRP7_Gas_Create)
  3602)   call RPF_TOUGH2_IRP7_Gas_Create%Init()
  3603)   
  3604) end function RPF_TOUGH2_IRP7_Gas_Create
  3605) 
  3606) ! ************************************************************************** !
  3607) 
  3608) subroutine RPF_TOUGH2_IRP7_Gas_Init(this)
  3609) 
  3610)   ! Initializes the Brooks-Corey Burdine gas relative permeability function 
  3611)   ! object
  3612) 
  3613)   implicit none
  3614)   
  3615)   class(rpf_TOUGH2_IRP7_gas_type) :: this
  3616) 
  3617)   call RPFBaseInit(this)
  3618)   this%Srg = UNINITIALIZED_DOUBLE
  3619)   
  3620) end subroutine RPF_TOUGH2_IRP7_Gas_Init
  3621) 
  3622) ! ************************************************************************** !
  3623) 
  3624) subroutine RPF_TOUGH2_IRP7_Gas_Verify(this,name,option)
  3625) 
  3626)   use Option_module
  3627) 
  3628)   implicit none
  3629)   
  3630)   class(rpf_TOUGH2_IRP7_gas_type) :: this
  3631)   character(len=MAXSTRINGLENGTH) :: name
  3632)   type(option_type) :: option
  3633)   
  3634)   character(len=MAXSTRINGLENGTH) :: string 
  3635) 
  3636)   if (index(name,'PERMEABILITY_FUNCTION') > 0) then
  3637)     string = name
  3638)   else
  3639)     string = trim(name) // 'PERMEABILITY_FUNCTION,TOUGH2_IRP7_GAS'
  3640)   endif    
  3641)   call RPFBaseVerify(this,string,option)
  3642)   if (Uninitialized(this%Srg)) then
  3643)     option%io_buffer = UninitializedMessage('GAS_RESIDUAL_SATURATION',string)
  3644)     call printErrMsg(option)
  3645)   endif  
  3646)   
  3647) end subroutine RPF_TOUGH2_IRP7_Gas_Verify
  3648) 
  3649) ! ************************************************************************** !
  3650) 
  3651) subroutine RPF_TOUGH2_IRP7_Gas_RelPerm(this,liquid_saturation, &
  3652)                                        relative_permeability,dkr_sat,option)
  3653)   ! 
  3654)   ! TOUGH2 IRP(7) equations from Appendix G of TOUGH2 user manual
  3655)   !
  3656)   use Option_module
  3657)   
  3658)   implicit none
  3659) 
  3660)   class(rpf_TOUGH2_IRP7_gas_type) :: this
  3661)   PetscReal, intent(in) :: liquid_saturation
  3662)   PetscReal, intent(out) :: relative_permeability
  3663)   PetscReal, intent(out) :: dkr_sat
  3664)   type(option_type), intent(inout) :: option
  3665)   
  3666)   PetscReal :: liquid_relative_permeability
  3667)   PetscReal :: liquid_dkr_sat
  3668)   PetscReal :: Se
  3669)   PetscReal :: Seg
  3670)   PetscReal :: dkr_Se
  3671)   PetscReal :: dSe_sat
  3672) 
  3673)   relative_permeability = 0.d0
  3674)   dkr_sat = 0.d0
  3675)   dkr_sat = dkr_sat / 0.d0
  3676)   dkr_sat = dkr_sat * 0.d0
  3677)   
  3678)                  ! essentially zero
  3679)   if (this%Srg <= 0.d0) then
  3680)     call RPF_Mualem_VG_Liq_RelPerm(this,liquid_saturation, &
  3681)                             liquid_relative_permeability, &
  3682)                             liquid_dkr_sat,option)
  3683)     relative_permeability = 1.d0 - liquid_relative_permeability
  3684)     return
  3685)   endif  
  3686)   
  3687)   if ((1.d0 - liquid_saturation) <= this%Srg) then
  3688)     relative_permeability = 0.d0
  3689)   else
  3690)     Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr - this%Srg)
  3691)     Seg = 1.d0 - Se
  3692)     relative_permeability = Seg**2*(1.d0-Se*Se)
  3693)     ! Mathematica Analytical solution (Heeho Park)
  3694)     dkr_Se = -2.d0*Seg**2.d0*Se - 2.d0*Seg*(1.d0-Se**2.d0)
  3695)     dSe_sat = 1.d0 / (1.d0 - this%Sr - this%Srg)
  3696)     dkr_sat = dkr_Se * dSe_sat
  3697)   endif
  3698)     
  3699) end subroutine RPF_TOUGH2_IRP7_Gas_RelPerm
  3700) ! End RPF: Tough2 IRP7 w/ VG-Mualem (Gas)
  3701) 
  3702) ! ************************************************************************** !
  3703) 
  3704) ! Begin RPF: Burdine, Brooks-Corey (Liquid)
  3705) function RPF_Burdine_BC_Liq_Create()
  3706) 
  3707)   ! Creates the Brooks-Corey Burdine relative permeability function object
  3708) 
  3709)   implicit none
  3710)   
  3711)   class(rpf_Burdine_BC_Liq_type), pointer :: RPF_Burdine_BC_Liq_Create
  3712)   
  3713)   allocate(RPF_Burdine_BC_Liq_Create)
  3714)   call RPF_Burdine_BC_Liq_Create%Init()
  3715)   
  3716) end function RPF_Burdine_BC_Liq_Create
  3717) 
  3718) ! ************************************************************************** !
  3719) 
  3720) subroutine RPF_Burdine_BC_Liq_Init(this)
  3721) 
  3722)   ! Initializes the Brooks-Corey Burdine relative permeability function object
  3723) 
  3724)   implicit none
  3725)   
  3726)   class(rpf_Burdine_BC_Liq_type) :: this
  3727) 
  3728)   call RPFBaseInit(this)
  3729)   this%lambda = UNINITIALIZED_DOUBLE
  3730)   
  3731) end subroutine RPF_Burdine_BC_Liq_Init
  3732) 
  3733) ! ************************************************************************** !
  3734) 
  3735) subroutine RPF_Burdine_BC_Liq_Verify(this,name,option)
  3736) 
  3737)   ! Initializes the Brooks-Corey Burdine relative permeability function object
  3738) 
  3739)   use Option_module
  3740)   
  3741)   implicit none
  3742)   
  3743)   class(rpf_Burdine_BC_liq_type) :: this
  3744)   character(len=MAXSTRINGLENGTH) :: name
  3745)   type(option_type) :: option
  3746)   
  3747)   character(len=MAXSTRINGLENGTH) :: string 
  3748) 
  3749)   if (index(name,'PERMEABILITY_FUNCTION') > 0) then
  3750)     string = name
  3751)   else
  3752)     string = trim(name) // 'PERMEABILITY_FUNCTION,BURDINE'
  3753)   endif    
  3754)   call RPFBaseVerify(this,name,option)
  3755)   if (Uninitialized(this%lambda)) then
  3756)     option%io_buffer = UninitializedMessage('LAMBDA',string)
  3757)     call printErrMsg(option)
  3758)   endif
  3759)   
  3760) end subroutine RPF_Burdine_BC_Liq_Verify
  3761) 
  3762) ! ************************************************************************** !
  3763) 
  3764) subroutine RPF_Burdine_BC_Liq_RelPerm(this,liquid_saturation, &
  3765)                               relative_permeability,dkr_sat,option)
  3766)   ! 
  3767)   ! Computes the relative permeability (and associated derivatives) as a 
  3768)   ! function of saturation
  3769)   ! 
  3770)   ! (1) Chen, J., J.W. Hopmans, M.E. Grismer (1999) "Parameter estimation of
  3771)   !     of two-fluid capillary pressure-saturation and permeability functions",
  3772)   !     Advances in Water Resources, Vol. 22, No. 5, pp 479-493,
  3773)   !     http://dx.doi.org/10.1016/S0309-1708(98)00025-6.
  3774)   !   
  3775)   ! Author: Glenn Hammond
  3776)   ! Date: 12/11/07, 09/23/14
  3777)   ! 
  3778)   use Option_module
  3779)   
  3780)   implicit none
  3781) 
  3782)   class(rpf_Burdine_BC_Liq_type) :: this
  3783)   PetscReal, intent(in) :: liquid_saturation
  3784)   PetscReal, intent(out) :: relative_permeability
  3785)   PetscReal, intent(out) :: dkr_sat
  3786)   type(option_type), intent(inout) :: option
  3787)   
  3788)   PetscReal :: Se
  3789)   PetscReal :: power
  3790)   PetscReal :: dkr_Se
  3791)   PetscReal :: dSe_sat
  3792) 
  3793)   relative_permeability = 0.d0
  3794)   dkr_sat = 0.d0
  3795)   
  3796)   Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr)
  3797)   if (Se >= 1.d0) then
  3798)     relative_permeability = 1.d0
  3799)     return
  3800)   else if (Se <= 0.d0) then
  3801)     relative_permeability = 0.d0
  3802)     return
  3803)   endif
  3804)   
  3805)   ! reference #1
  3806)   power = 3.d0+2.d0/this%lambda
  3807)   relative_permeability = Se**power
  3808)   dkr_Se = power*relative_permeability/Se          
  3809)   dSe_sat = 1.d0 / (1.d0 - this%Sr)
  3810)   dkr_sat = dkr_Se * dSe_sat
  3811)   
  3812) end subroutine RPF_Burdine_BC_Liq_RelPerm
  3813) ! End RPF: Burdine, Brooks-Corey (Liquid)
  3814) 
  3815) ! ************************************************************************** !
  3816) 
  3817) ! Begin RPF: Burdine, Brooks-Corey (Gas)
  3818) function RPF_Burdine_BC_Gas_Create()
  3819) 
  3820)   ! Creates the Brooks-Corey Burdine gas relative permeability function
  3821)   ! object
  3822) 
  3823)   implicit none
  3824)   
  3825)   class(rpf_Burdine_BC_gas_type), pointer :: RPF_Burdine_BC_Gas_Create
  3826)   
  3827)   allocate(RPF_Burdine_BC_Gas_Create)
  3828)   call RPF_Burdine_BC_Gas_Create%Init()
  3829)   
  3830) end function RPF_Burdine_BC_Gas_Create
  3831) 
  3832) ! ************************************************************************** !
  3833) 
  3834) subroutine RPF_Burdine_BC_Gas_Init(this)
  3835) 
  3836)   ! Initializes the Brooks-Corey Burdine gas relative permeability function 
  3837)   ! object
  3838) 
  3839)   implicit none
  3840)   
  3841)   class(rpf_Burdine_BC_gas_type) :: this
  3842) 
  3843)   call RPFBaseInit(this)
  3844)   this%Srg = UNINITIALIZED_DOUBLE
  3845)   
  3846) end subroutine RPF_Burdine_BC_Gas_Init
  3847) 
  3848) ! ************************************************************************** !
  3849) 
  3850) subroutine RPF_Burdine_BC_Gas_Verify(this,name,option)
  3851) 
  3852)   use Option_module
  3853) 
  3854)   implicit none
  3855)   
  3856)   class(rpf_Burdine_BC_gas_type) :: this
  3857)   character(len=MAXSTRINGLENGTH) :: name
  3858)   type(option_type) :: option
  3859)   
  3860)   character(len=MAXSTRINGLENGTH) :: string 
  3861) 
  3862)   if (index(name,'PERMEABILITY_FUNCTION') > 0) then
  3863)     string = name
  3864)   else
  3865)     string = trim(name) // 'PERMEABILITY_FUNCTION,BURDINE_BC_GAS'
  3866)   endif    
  3867)   call RPFBaseVerify(this,string,option)
  3868)   if (Uninitialized(this%Srg)) then
  3869)     option%io_buffer = UninitializedMessage('GAS_RESIDUAL_SATURATION',string)
  3870)     call printErrMsg(option)
  3871)   endif  
  3872)   
  3873) end subroutine RPF_Burdine_BC_Gas_Verify
  3874) 
  3875) ! ************************************************************************** !
  3876) 
  3877) subroutine RPF_Burdine_BC_Gas_RelPerm(this,liquid_saturation, &
  3878)                                      relative_permeability,dkr_sat,option)
  3879)   ! 
  3880)   ! Computes the relative permeability (and associated derivatives) as a 
  3881)   ! function of saturation
  3882)   ! 
  3883)   ! (1) Chen, J., J.W. Hopmans, M.E. Grismer (1999) "Parameter estimation of
  3884)   !     of two-fluid capillary pressure-saturation and permeability functions",
  3885)   !     Advances in Water Resources, Vol. 22, No. 5, pp 479-493,
  3886)   !     http://dx.doi.org/10.1016/S0309-1708(98)00025-6.
  3887)   !   
  3888)   ! Author: Glenn Hammond
  3889)   ! Date: 12/11/07, 09/23/14
  3890)   ! 
  3891)   use Option_module
  3892)   
  3893)   implicit none
  3894) 
  3895)   class(rpf_Burdine_BC_gas_type) :: this
  3896)   PetscReal, intent(in) :: liquid_saturation
  3897)   PetscReal, intent(out) :: relative_permeability
  3898)   PetscReal, intent(out) :: dkr_sat
  3899)   type(option_type), intent(inout) :: option
  3900)   
  3901)   PetscReal :: Se
  3902)   PetscReal :: Seg
  3903)   PetscReal :: dkr_Se
  3904)   PetscReal :: dSe_sat
  3905)   
  3906)   Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr - this%Srg)
  3907)   
  3908)   relative_permeability = 0.d0
  3909)   dkr_sat = UNINITIALIZED_DOUBLE
  3910)   if (Se >= 1.d0) then
  3911)     relative_permeability = 0.d0
  3912)     return
  3913)   else if (Se <=  0.d0) then
  3914)     relative_permeability = 1.d0
  3915)     return
  3916)   endif
  3917)   
  3918)   Seg = 1.d0 - Se
  3919)         ! reference #1
  3920)   relative_permeability = Seg*Seg*(1.d0-Se**(1.d0+2.d0/this%lambda))
  3921)   ! Mathematica Analytical solution (Heeho Park)
  3922)   dkr_Se = -(1.d0+2.d0/this%lambda)*Seg**2.d0*Se**(2.d0/this%lambda) &
  3923)            - 2.d0*Seg*(1.d0-Se**(1.d0+2.d0/this%lambda))
  3924)   dSe_sat = 1.d0 / (1.d0 - this%Sr - this%Srg)
  3925)   dkr_sat = dkr_Se * dSe_sat
  3926)   
  3927) end subroutine RPF_Burdine_BC_Gas_RelPerm
  3928) ! End RPF: Burdine, Brooks-Corey (Gas)
  3929) 
  3930) ! ************************************************************************** !
  3931) 
  3932) ! Begin RPF: Mualem, Brooks-Corey (Liq)
  3933) function RPF_Mualem_BC_Liq_Create()
  3934) 
  3935)   ! Creates the Brooks-Corey Mualem liquid relative permeability function object
  3936) 
  3937)   implicit none
  3938)   
  3939)   class(rpf_Mualem_BC_liq_type), pointer :: RPF_Mualem_BC_Liq_Create
  3940)   
  3941)   allocate(RPF_Mualem_BC_Liq_Create)
  3942)   call RPF_Mualem_BC_Liq_Create%Init()
  3943)   
  3944) end function RPF_Mualem_BC_Liq_Create
  3945) 
  3946) ! ************************************************************************** !
  3947) 
  3948) subroutine RPF_Mualem_BC_Liq_Init(this)
  3949) 
  3950)   ! Initializes the Brooks-Corey Mualem liquid relative permeability function 
  3951)   ! object
  3952) 
  3953)   implicit none
  3954)   
  3955)   class(rpf_Mualem_BC_liq_type) :: this
  3956) 
  3957)   call RPFBaseInit(this)
  3958)   this%lambda = UNINITIALIZED_DOUBLE
  3959) 
  3960) end subroutine RPF_Mualem_BC_Liq_Init
  3961) 
  3962) ! ************************************************************************** !
  3963) 
  3964) subroutine RPF_Mualem_BC_Liq_Verify(this,name,option)
  3965) 
  3966)   ! Initializes the Brooks-Corey Mualem liquid relative permeability function object
  3967) 
  3968)   use Option_module
  3969)   
  3970)   implicit none
  3971)   
  3972)   class(rpf_Mualem_BC_liq_type) :: this
  3973)   character(len=MAXSTRINGLENGTH) :: name
  3974)   type(option_type) :: option
  3975)   
  3976)   character(len=MAXSTRINGLENGTH) :: string 
  3977) 
  3978)   if (index(name,'PERMEABILITY_FUNCTION') > 0) then
  3979)     string = name
  3980)   else
  3981)     string = trim(name) // 'PERMEABILITY_FUNCTION,MUALEM'
  3982)   endif    
  3983)   call RPFBaseVerify(this,name,option)
  3984)   if (Uninitialized(this%lambda)) then
  3985)     option%io_buffer = UninitializedMessage('LAMBDA',string)
  3986)     call printErrMsg(option)
  3987)   endif
  3988)   
  3989) end subroutine RPF_Mualem_BC_Liq_Verify
  3990) 
  3991) ! ************************************************************************** !
  3992) 
  3993) subroutine RPF_Mualem_BC_Liq_RelPerm(this,liquid_saturation, &
  3994)                               relative_permeability,dkr_sat,option)
  3995)   ! 
  3996)   ! Computes the relative permeability (and associated derivatives) as a 
  3997)   ! function of saturation
  3998)   ! 
  3999)   ! (1) Chen, J., J.W. Hopmans, M.E. Grismer (1999) "Parameter estimation of
  4000)   !     of two-fluid capillary pressure-saturation and permeability functions",
  4001)   !     Advances in Water Resources, Vol. 22, No. 5, pp 479-493,
  4002)   !     http://dx.doi.org/10.1016/S0309-1708(98)00025-6.
  4003)   !   
  4004)   ! Author: Glenn Hammond
  4005)   ! Date: 12/11/07, 09/23/14
  4006)   ! 
  4007)   use Option_module
  4008)   
  4009)   implicit none
  4010) 
  4011)   class(rpf_Mualem_BC_Liq_type) :: this
  4012)   PetscReal, intent(in) :: liquid_saturation
  4013)   PetscReal, intent(out) :: relative_permeability
  4014)   PetscReal, intent(out) :: dkr_sat
  4015)   type(option_type), intent(inout) :: option
  4016)   
  4017)   PetscReal :: Se
  4018)   PetscReal :: power
  4019)   PetscReal :: dkr_Se
  4020)   PetscReal :: dSe_sat
  4021) 
  4022)   relative_permeability = 0.d0
  4023)   dkr_sat = 0.d0
  4024)   
  4025)   Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr)
  4026)   if (Se >= 1.d0) then
  4027)     relative_permeability = 1.d0
  4028)     return
  4029)   else if (Se <= 0.d0) then
  4030)     relative_permeability = 0.d0
  4031)     return
  4032)   endif
  4033)   
  4034)   ! reference #1
  4035)   power = 2.5d0+2.d0/this%lambda
  4036)   relative_permeability = Se**power
  4037)   dkr_Se = power*relative_permeability/Se          
  4038)   dSe_sat = 1.d0 / (1.d0 - this%Sr)
  4039)   dkr_sat = dkr_Se * dSe_sat 
  4040) 
  4041) end subroutine RPF_Mualem_BC_Liq_RelPerm
  4042) ! End RPF: Mualem, Brooks-Corey (Liq)
  4043) 
  4044) ! ************************************************************************** !
  4045) 
  4046) ! Begin RPF: Mualem, Brooks-Corey (Gas)
  4047) function RPF_Mualem_BC_Gas_Create()
  4048) 
  4049)   ! Creates the Brooks-Corey Mualem gas relative permeability function object
  4050) 
  4051)   implicit none
  4052)   
  4053)   class(rpf_Mualem_BC_gas_type), pointer :: RPF_Mualem_BC_Gas_Create
  4054)   
  4055)   allocate(RPF_Mualem_BC_Gas_Create)
  4056)   call RPF_Mualem_BC_Gas_Create%Init()
  4057)   
  4058) end function RPF_Mualem_BC_Gas_Create
  4059) 
  4060) ! ************************************************************************** !
  4061) 
  4062) subroutine RPF_Mualem_BC_Gas_Init(this)
  4063) 
  4064)   ! Initializes the Brooks-Corey Mualem gas relative permeability function 
  4065)   ! object
  4066) 
  4067)   implicit none
  4068)   
  4069)   class(rpf_Mualem_BC_gas_type) :: this
  4070) 
  4071)   call RPFBaseInit(this)
  4072)   this%Srg = UNINITIALIZED_DOUBLE
  4073)   
  4074) end subroutine RPF_Mualem_BC_Gas_Init
  4075) 
  4076) ! ************************************************************************** !
  4077) 
  4078) subroutine RPF_Mualem_BC_Gas_Verify(this,name,option)
  4079) 
  4080)   use Option_module
  4081) 
  4082)   implicit none
  4083)   
  4084)   class(rpf_Mualem_BC_gas_type) :: this
  4085)   character(len=MAXSTRINGLENGTH) :: name
  4086)   type(option_type) :: option
  4087)   
  4088)   character(len=MAXSTRINGLENGTH) :: string 
  4089) 
  4090)   if (index(name,'PERMEABILITY_FUNCTION') > 0) then
  4091)     string = name
  4092)   else
  4093)     string = trim(name) // 'PERMEABILITY_FUNCTION,MUALEM_BC_GAS'
  4094)   endif    
  4095)   call RPFBaseVerify(this,string,option)
  4096)   if (Uninitialized(this%Srg)) then
  4097)     option%io_buffer = UninitializedMessage('GAS_RESIDUAL_SATURATION',string)
  4098)     call printErrMsg(option)
  4099)   endif  
  4100)   
  4101) end subroutine RPF_Mualem_BC_Gas_Verify
  4102) 
  4103) ! ************************************************************************** !
  4104) 
  4105) subroutine RPF_Mualem_BC_Gas_RelPerm(this,liquid_saturation, &
  4106)                                        relative_permeability,dkr_sat,option)
  4107)   ! 
  4108)   ! Computes the relative permeability (and associated derivatives) as a 
  4109)   ! function of saturation
  4110)   ! 
  4111)   ! (1) Chen, J., J.W. Hopmans, M.E. Grismer (1999) "Parameter estimation of
  4112)   !     of two-fluid capillary pressure-saturation and permeability functions",
  4113)   !     Advances in Water Resources, Vol. 22, No. 5, pp 479-493,
  4114)   !     http://dx.doi.org/10.1016/S0309-1708(98)00025-6.
  4115)   !   
  4116)   ! Author: Glenn Hammond
  4117)   ! Date: 12/11/07, 09/23/14
  4118)   ! 
  4119)   use Option_module
  4120)   
  4121)   implicit none
  4122) 
  4123)   class(rpf_Mualem_BC_gas_type) :: this
  4124)   PetscReal, intent(in) :: liquid_saturation
  4125)   PetscReal, intent(out) :: relative_permeability
  4126)   PetscReal, intent(out) :: dkr_sat
  4127)   type(option_type), intent(inout) :: option
  4128)   
  4129)   PetscReal :: Se
  4130)   PetscReal :: Seg
  4131)   PetscReal :: dkr_Se
  4132)   PetscReal :: dSe_sat
  4133)   
  4134)   Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr - this%Srg)
  4135)   
  4136)   relative_permeability = 0.d0
  4137)   dkr_sat = UNINITIALIZED_DOUBLE
  4138)   if (Se >= 1.d0) then
  4139)     relative_permeability = 0.d0
  4140)     return
  4141)   else if (Se <=  0.d0) then
  4142)     relative_permeability = 1.d0
  4143)     return
  4144)   endif
  4145)   
  4146)   Seg = 1.d0 - Se
  4147)   ! reference Table 2
  4148)   relative_permeability = sqrt(Seg)* &
  4149)                               (1.d0-Se**(1.d0+1.d0/this%lambda))**2.d0
  4150)   ! Mathematica Analytical solution (Heeho Park)
  4151)   dkr_Se = -2.d0*(1.d0+1.d0/this%lambda)*sqrt(Seg)*Se**(1.d0/this%lambda) &
  4152)           * (1.d0-Se**(1.d0+1.d0/this%lambda)) &
  4153)           - (1.d0-Se**(1.d0+1.d0/this%lambda))**2.d0/(2.d0*sqrt(Seg))
  4154)   dSe_sat = 1.d0 / (1.d0 - this%Sr - this%Srg)
  4155)   dkr_sat = dkr_Se * dSe_sat
  4156)   
  4157) end subroutine RPF_Mualem_BC_Gas_RelPerm
  4158) ! End RPF: Mualem, Brooks-Corey (Gas)
  4159) 
  4160) ! ************************************************************************** !
  4161) 
  4162) ! Begin RPF: Burdine, Van Genuchten (Liq)
  4163) function RPF_Burdine_VG_Liq_Create()
  4164) 
  4165)   ! Creates the van Genutchten Mualem relative permeability function object
  4166) 
  4167)   implicit none
  4168)   
  4169)   class(rpf_burdine_vg_liq_type), pointer :: RPF_Burdine_VG_Liq_Create
  4170)   
  4171)   allocate(RPF_Burdine_VG_Liq_Create)
  4172)   call RPF_Burdine_VG_Liq_Create%Init()
  4173)   
  4174) end function RPF_Burdine_VG_Liq_Create
  4175) 
  4176) ! ************************************************************************** !
  4177) 
  4178) subroutine RPF_Burdine_VG_Liq_Init(this)
  4179) 
  4180)   ! Initializes the van Genutchten Mualem relative permeability function object
  4181) 
  4182)   implicit none
  4183)   
  4184)   class(rpf_Burdine_VG_liq_type) :: this
  4185) 
  4186)   call RPFBaseInit(this)
  4187)   this%m = UNINITIALIZED_DOUBLE
  4188)   
  4189) end subroutine RPF_Burdine_VG_Liq_Init
  4190) 
  4191) ! ************************************************************************** !
  4192) 
  4193) subroutine RPF_Burdine_VG_Liq_Verify(this,name,option)
  4194) 
  4195)   use Option_module
  4196) 
  4197)   implicit none
  4198)   
  4199)   class(rpf_Burdine_VG_liq_type) :: this
  4200)   character(len=MAXSTRINGLENGTH) :: name
  4201)   type(option_type) :: option
  4202)   
  4203)   character(len=MAXSTRINGLENGTH) :: string
  4204)   
  4205)   if (index(name,'PERMEABILITY_FUNCTION') > 0) then
  4206)     string = name
  4207)   else
  4208)     string = trim(name) // 'PERMEABILITY_FUNCTION,MUALEM'
  4209)   endif  
  4210)   call RPFBaseVerify(this,string,option)
  4211)   if (Uninitialized(this%m)) then
  4212)     option%io_buffer = UninitializedMessage('M',string)
  4213)     call printErrMsg(option)
  4214)   endif   
  4215)   
  4216) end subroutine RPF_Burdine_VG_Liq_Verify
  4217) 
  4218) ! ************************************************************************** !
  4219) 
  4220) subroutine RPF_Burdine_VG_Liq_RelPerm(this,liquid_saturation, &
  4221)                               relative_permeability,dkr_sat,option)
  4222)   ! 
  4223)   ! Computes the relative permeability (and associated derivatives) as a 
  4224)   ! function of saturation
  4225)   ! 
  4226)   ! (1) Chen, J., J.W. Hopmans, M.E. Grismer (1999) "Parameter estimation of
  4227)   !     of two-fluid capillary pressure-saturation and permeability functions",
  4228)   !     Advances in Water Resources, Vol. 22, No. 5, pp 479-493,
  4229)   !     http://dx.doi.org/10.1016/S0309-1708(98)00025-6.
  4230)   !   
  4231)   ! Author: Glenn Hammond
  4232)   ! Date: 12/11/07, 09/23/14
  4233)   ! 
  4234)   use Option_module
  4235)   use Utility_module
  4236)   
  4237)   implicit none
  4238) 
  4239)   class(rpf_Burdine_VG_liq_type) :: this
  4240)   PetscReal, intent(in) :: liquid_saturation
  4241)   PetscReal, intent(out) :: relative_permeability
  4242)   PetscReal, intent(out) :: dkr_sat
  4243)   type(option_type), intent(inout) :: option
  4244)   
  4245)   PetscReal :: Se
  4246)   PetscReal :: one_over_m
  4247)   PetscReal :: Se_one_over_m
  4248)   PetscReal :: dkr_Se
  4249)   PetscReal :: dSe_sat
  4250) 
  4251)   relative_permeability = 0.d0
  4252)   dkr_sat = 0.d0
  4253)   
  4254)   Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr)
  4255)   if (Se >= 1.d0) then
  4256)     relative_permeability = 1.d0
  4257)     return
  4258)   else if (Se <= 0.d0) then
  4259)     relative_permeability = 0.d0
  4260)     return
  4261)   endif
  4262)   
  4263)   one_over_m = 1.d0/this%m
  4264)   Se_one_over_m = Se**one_over_m
  4265)   relative_permeability = Se*Se*(1.d0-(1.d0-Se_one_over_m)**this%m)
  4266)   dkr_Se = 2.d0*relative_permeability/Se + &
  4267)                  Se*Se_one_over_m*(1.d0-Se_one_over_m)**(this%m-1.d0)
  4268)   dSe_sat = 1.d0 / (1.d0 - this%Sr)
  4269)   dkr_sat = dkr_Se * dSe_sat
  4270)   
  4271) end subroutine RPF_Burdine_VG_Liq_RelPerm
  4272) ! End RPF: Burdine, Van Genuchten (Liq)
  4273) 
  4274) ! ************************************************************************** !
  4275) 
  4276) ! Begin RPF: Burdine, Van Genuchten (Gas)
  4277) function RPF_Burdine_VG_Gas_Create()
  4278) 
  4279)   ! Creates the Brooks-Corey Burdine gas relative permeability function object
  4280) 
  4281)   implicit none
  4282)   
  4283)   class(rpf_Burdine_VG_gas_type), pointer :: RPF_Burdine_VG_Gas_Create
  4284)   
  4285)   allocate(RPF_Burdine_VG_Gas_Create)
  4286)   call RPF_Burdine_VG_Gas_Create%Init()
  4287)   
  4288) end function RPF_Burdine_VG_Gas_Create
  4289) 
  4290) ! ************************************************************************** !
  4291) 
  4292) subroutine RPF_Burdine_VG_Gas_Init(this)
  4293) 
  4294)   ! Initializes the Brooks-Corey Burdine gas relative permeability function 
  4295)   ! object
  4296) 
  4297)   implicit none
  4298)   
  4299)   class(rpf_Burdine_VG_gas_type) :: this
  4300) 
  4301)   call RPFBaseInit(this)
  4302)   this%Srg = UNINITIALIZED_DOUBLE
  4303)   
  4304) end subroutine RPF_Burdine_VG_Gas_Init
  4305) 
  4306) ! ************************************************************************** !
  4307) 
  4308) subroutine RPF_Burdine_VG_Gas_Verify(this,name,option)
  4309) 
  4310)   use Option_module
  4311) 
  4312)   implicit none
  4313)   
  4314)   class(rpf_Burdine_VG_gas_type) :: this
  4315)   character(len=MAXSTRINGLENGTH) :: name
  4316)   type(option_type) :: option
  4317)   
  4318)   character(len=MAXSTRINGLENGTH) :: string 
  4319) 
  4320)   if (index(name,'PERMEABILITY_FUNCTION') > 0) then
  4321)     string = name
  4322)   else
  4323)     string = trim(name) // 'PERMEABILITY_FUNCTION,BURDINE_VG_GAS'
  4324)   endif    
  4325)   call RPFBaseVerify(this,string,option)
  4326)   if (Uninitialized(this%Srg)) then
  4327)     option%io_buffer = UninitializedMessage('GAS_RESIDUAL_SATURATION',string)
  4328)     call printErrMsg(option)
  4329)   endif  
  4330)   
  4331) end subroutine RPF_Burdine_VG_Gas_Verify
  4332) 
  4333) ! ************************************************************************** !
  4334) 
  4335) subroutine RPF_Burdine_VG_Gas_RelPerm(this,liquid_saturation, &
  4336)                                      relative_permeability,dkr_sat,option)
  4337)   ! 
  4338)   ! Computes the relative permeability (and associated derivatives) as a 
  4339)   ! function of saturation
  4340)   ! 
  4341)   ! (1) Chen, J., J.W. Hopmans, M.E. Grismer (1999) "Parameter estimation of
  4342)   !     of two-fluid capillary pressure-saturation and permeability functions",
  4343)   !     Advances in Water Resources, Vol. 22, No. 5, pp 479-493,
  4344)   !     http://dx.doi.org/10.1016/S0309-1708(98)00025-6.
  4345)   !   
  4346)   ! Author: Glenn Hammond
  4347)   ! Date: 12/11/07, 09/23/14
  4348) 
  4349)   use Option_module
  4350)   
  4351)   implicit none
  4352) 
  4353)   class(rpf_Burdine_VG_gas_type) :: this
  4354)   PetscReal, intent(in) :: liquid_saturation
  4355)   PetscReal, intent(out) :: relative_permeability
  4356)   PetscReal, intent(out) :: dkr_sat
  4357)   type(option_type), intent(inout) :: option
  4358)   
  4359)   PetscReal :: Se
  4360)   PetscReal :: Seg
  4361)   PetscReal :: dkr_Se
  4362)   PetscReal :: dSe_sat
  4363)   
  4364)   relative_permeability = 0.d0
  4365)   dkr_sat = 0.d0
  4366) 
  4367)   Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr - this%Srg)
  4368)   if (Se >= 1.d0) then
  4369)     relative_permeability = 0.d0
  4370)     return
  4371)   else if (Se <=  0.d0) then
  4372)     relative_permeability = 1.d0
  4373)     return
  4374)   endif
  4375)   
  4376)   Seg = 1.d0 - Se
  4377)   ! reference Table 2
  4378)   relative_permeability = Seg*Seg*(1.d0-Se**(1.d0/this%m))**this%m
  4379)   dkr_Se = -Seg**2.d0*Se**(1.d0/this%m-1.d0) &
  4380)           *(1.d0-Se**(1.d0/this%m))**(this%m-1.d0) &
  4381)           - 2.d0*Seg*(1.d0-Se**(1.d0/this%m))**this%m
  4382)   dSe_sat = 1.d0 / (1.d0 - this%Sr - this%Srg)
  4383)   dkr_sat = dkr_Se * dSe_sat
  4384)   
  4385) end subroutine RPF_Burdine_VG_Gas_RelPerm
  4386) ! End RPF: Burdine, Van Genuchten (Gas)
  4387) 
  4388) ! ************************************************************************** !
  4389) 
  4390) ! Begin RPF: Mualem, Linear (Liquid)
  4391) function RPF_Mualem_Linear_Liq_Create()
  4392) 
  4393)   ! Creates the Linear Mualem relative permeability function object
  4394) 
  4395)   implicit none
  4396)   
  4397)   class(rpf_Mualem_linear_liq_type), pointer :: RPF_Mualem_Linear_Liq_Create
  4398)   
  4399)   allocate(RPF_Mualem_Linear_Liq_Create)
  4400)   call RPF_Mualem_Linear_Liq_Create%Init()
  4401)   
  4402) end function RPF_Mualem_Linear_Liq_Create
  4403) 
  4404) ! ************************************************************************** !
  4405) 
  4406) subroutine RPF_Mualem_Linear_Liq_Init(this)
  4407) 
  4408)   ! Initializes the Linear Mualem relative permeability function 
  4409)   ! object
  4410) 
  4411)   implicit none
  4412)   
  4413)   class(rpf_Mualem_Linear_liq_type) :: this
  4414) 
  4415)   call RPFBaseInit(this)
  4416)   this%alpha = UNINITIALIZED_DOUBLE
  4417)   this%pcmax = UNINITIALIZED_DOUBLE
  4418)   
  4419) end subroutine RPF_Mualem_Linear_Liq_Init
  4420) 
  4421) ! ************************************************************************** !
  4422) 
  4423) subroutine RPF_Mualem_Linear_Liq_Verify(this,name,option)
  4424) 
  4425)   use Option_module
  4426) 
  4427)   implicit none
  4428)   
  4429)   class(rpf_Mualem_Linear_liq_type) :: this
  4430)   character(len=MAXSTRINGLENGTH) :: name
  4431)   type(option_type) :: option
  4432)   
  4433)   character(len=MAXSTRINGLENGTH) :: string
  4434)   
  4435)   if (index(name,'PERMEABILITY_FUNCTION') > 0) then
  4436)     string = name
  4437)   else
  4438)     string = trim(name) // 'PERMEABILITY_FUNCTION,MUALEM'
  4439)   endif  
  4440)   call RPFBaseVerify(this,string,option)
  4441)   if (Uninitialized(this%alpha)) then
  4442)     option%io_buffer = UninitializedMessage('ALPHA',string)
  4443)     call printErrMsg(option)
  4444)   endif  
  4445)   if (Uninitialized(this%pcmax)) then
  4446)     option%io_buffer = UninitializedMessage('MAX_CAPILLARY_PRESSURE',string)
  4447)     call printErrMsg(option)
  4448)   endif
  4449)   
  4450) end subroutine RPF_Mualem_Linear_Liq_Verify
  4451) 
  4452) ! ************************************************************************** !
  4453) 
  4454) subroutine RPF_Mualem_Linear_Liq_RelPerm(this,liquid_saturation, &
  4455)                               relative_permeability,dkr_sat,option)
  4456)   ! 
  4457)   ! Computes the relative permeability (and associated derivatives) as a 
  4458)   ! function of saturation
  4459)   ! 
  4460)   !   
  4461)   ! Author: Bwalya Malama, Heeho Park
  4462)   ! Date: 11/14/14
  4463)   !
  4464)   use Option_module
  4465)   use Utility_module
  4466)   
  4467)   implicit none
  4468) 
  4469)   class(rpf_Mualem_Linear_liq_type) :: this
  4470)   PetscReal, intent(in) :: liquid_saturation
  4471)   PetscReal, intent(out) :: relative_permeability
  4472)   PetscReal, intent(out) :: dkr_sat
  4473)   type(option_type), intent(inout) :: option
  4474)   
  4475)   PetscReal :: Se
  4476)   PetscReal :: one_over_alpha
  4477)   PetscReal :: pct_over_pcmax
  4478)   PetscReal :: pc_over_pcmax
  4479)   PetscReal :: pc_log_ratio
  4480)   PetscReal :: dkr_Se
  4481)   PetscReal :: dSe_sat
  4482)   
  4483)   relative_permeability = 0.d0
  4484)   dkr_sat = 0.d0
  4485)   
  4486)   Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr)
  4487)   if (Se >= 1.d0) then
  4488)     relative_permeability = 1.d0
  4489)     return
  4490)   else if (Se <= 0.d0) then
  4491)     relative_permeability = 0.d0
  4492)     return
  4493)   endif
  4494)   
  4495)   one_over_alpha = 1.d0/this%alpha
  4496)   pct_over_pcmax = one_over_alpha/this%pcmax
  4497)   pc_over_pcmax = 1.d0-(1.d0-pct_over_pcmax)*Se
  4498)   pc_log_ratio = log(pc_over_pcmax) / log(pct_over_pcmax)
  4499)   relative_permeability = (Se**0.5d0)*(pc_log_ratio**2.d0)
  4500)   ! ***used Mathematica to verify***
  4501)   ! In[3]:
  4502)   ! D[Se^(1/2)*(Log[1 - (1 - pctoverpcmax)*Se]/Log[pctoverpcmax])^2, Se]
  4503)   ! Out[3]:
  4504)   ! (2 (-1 + pctoverpcmax) Sqrt[Se]
  4505)   !  Log[1 - (1 - pctoverpcmax) Se])/((1 - (1 - pctoverpcmax) Se) Log[
  4506)   !  pctoverpcmax]^2) + Log[1 - (1 - pctoverpcmax) Se]^2/(
  4507)   ! 2 Sqrt[Se] Log[pctoverpcmax]^2)
  4508)   dkr_Se = 2.d0*(-1.d0+pct_over_pcmax)*sqrt(Se)* log(pc_over_pcmax) / &
  4509)     (pc_over_pcmax*log(pct_over_pcmax)**2.d0) + &
  4510)     log(pc_over_pcmax)**2.d0 / (2.d0*sqrt(Se)*log(pct_over_pcmax)**2.d0)
  4511)   dSe_sat = 1.d0 / (1.d0 - this%Sr)
  4512)   dkr_sat = dkr_Se * dSe_sat
  4513)          
  4514) end subroutine RPF_Mualem_Linear_Liq_RelPerm
  4515) ! End RPF: Mualem, Linear (Liquid)
  4516) 
  4517) ! ************************************************************************** !
  4518) 
  4519) ! Begin RPF: Mualem, Linear (Gas)
  4520) function RPF_Mualem_Linear_Gas_Create()
  4521) 
  4522)   ! Creates the Linear Mualem gas relative permeability function object
  4523) 
  4524)   implicit none
  4525)   
  4526)   class(rpf_Mualem_Linear_gas_type), pointer :: RPF_Mualem_Linear_Gas_Create
  4527)   
  4528)   allocate(RPF_Mualem_Linear_Gas_Create)
  4529)   call RPF_Mualem_Linear_Gas_Create%Init()
  4530)   
  4531) end function RPF_Mualem_Linear_Gas_Create
  4532)  
  4533) ! ************************************************************************** !
  4534) 
  4535) subroutine RPF_Mualem_Linear_Gas_Init(this)
  4536) 
  4537)   ! Initializes the Linear Mualem gas relative permeability function 
  4538)   ! object
  4539) 
  4540)   implicit none
  4541)   
  4542)   class(rpf_Mualem_Linear_gas_type) :: this
  4543) 
  4544)   call RPFBaseInit(this)
  4545)   this%Srg = UNINITIALIZED_DOUBLE
  4546)   this%alpha = UNINITIALIZED_DOUBLE
  4547)   this%pcmax = UNINITIALIZED_DOUBLE
  4548)   
  4549) end subroutine RPF_Mualem_Linear_Gas_Init
  4550) 
  4551) ! ************************************************************************** !
  4552) 
  4553) subroutine RPF_Mualem_Linear_Gas_Verify(this,name,option)
  4554) 
  4555)   use Option_module
  4556) 
  4557)   implicit none
  4558)   
  4559)   class(rpf_Mualem_Linear_gas_type) :: this
  4560)   character(len=MAXSTRINGLENGTH) :: name
  4561)   type(option_type) :: option
  4562)   
  4563)   character(len=MAXSTRINGLENGTH) :: string 
  4564) 
  4565)   if (index(name,'PERMEABILITY_FUNCTION') > 0) then
  4566)     string = name
  4567)   else
  4568)     string = trim(name) // 'PERMEABILITY_FUNCTION,MUALEM_LINEAR_GAS'
  4569)   endif    
  4570)   call RPFBaseVerify(this,string,option)
  4571)   if (Uninitialized(this%Srg)) then
  4572)     option%io_buffer = UninitializedMessage('GAS_RESIDUAL_SATURATION',string)
  4573)     call printErrMsg(option)
  4574)   endif  
  4575)   if (Uninitialized(this%alpha)) then
  4576)     option%io_buffer = UninitializedMessage('ALPHA',string)
  4577)     call printErrMsg(option)
  4578)   endif  
  4579)   if (Uninitialized(this%pcmax)) then
  4580)     option%io_buffer = UninitializedMessage('MAX_CAPILLARY_PRESSURE',string)
  4581)     call printErrMsg(option)
  4582)   endif
  4583)   
  4584) end subroutine RPF_Mualem_Linear_Gas_Verify
  4585) 
  4586) ! ************************************************************************** !
  4587) 
  4588) subroutine RPF_Mualem_Linear_Gas_RelPerm(this,liquid_saturation, &
  4589)                                      relative_permeability,dkr_sat,option)
  4590)   ! 
  4591)   ! Computes the relative permeability (and associated derivatives) as a 
  4592)   ! function of saturation
  4593)   !
  4594)   !
  4595)   !
  4596)   ! Author: Bwalya Malama, Heeho Park
  4597)   ! Date: 11/14/14
  4598) 
  4599)   use Option_module
  4600)   
  4601)   implicit none
  4602) 
  4603)   class(rpf_Mualem_Linear_gas_type) :: this
  4604)   PetscReal, intent(in) :: liquid_saturation
  4605)   PetscReal, intent(out) :: relative_permeability
  4606)   PetscReal, intent(out) :: dkr_sat
  4607)   type(option_type), intent(inout) :: option
  4608)   
  4609)   PetscReal :: Se
  4610)   PetscReal :: Seg
  4611)   PetscReal :: liquid_relative_permeability
  4612)   PetscReal :: liquid_dkr_sat
  4613)   
  4614)   call RPF_Mualem_Linear_Liq_RelPerm(this,liquid_saturation, &
  4615)                         liquid_relative_permeability, &
  4616)                         liquid_dkr_sat,option)
  4617)   
  4618)   relative_permeability = 0.d0
  4619)   ! initialize to derivative to NaN so that not mistakenly used.
  4620)   dkr_sat = 0.d0
  4621)   dkr_sat = dkr_sat / 0.d0
  4622)   dkr_sat = dkr_sat * 0.d0
  4623) 
  4624)   Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr - this%Srg)
  4625)   if (Se >= 1.d0) then
  4626)     relative_permeability = 0.d0
  4627)     return
  4628)   else if (Se <=  0.d0) then
  4629)     relative_permeability = 1.d0
  4630)     return
  4631)   endif
  4632)   
  4633)   Seg = 1.d0 - Se
  4634)   ! reference Table 2
  4635)   relative_permeability = Seg**0.5d0 * &
  4636)                  (1.d0-sqrt(liquid_relative_permeability*Se**(-0.5d0)))**2.d0
  4637) 
  4638) end subroutine RPF_Mualem_Linear_Gas_RelPerm
  4639) ! End RPF: Mualem, Linear (Gas)
  4640) 
  4641) ! ************************************************************************** !
  4642) 
  4643) ! Begin RPF: Burdine, Linear (Liquid)
  4644) function RPF_Burdine_Linear_Liq_Create()
  4645) 
  4646)   ! Creates the Linear Burdine relative permeability function object
  4647) 
  4648)   implicit none
  4649)   
  4650)   class(rpf_Burdine_linear_liq_type), pointer :: RPF_Burdine_Linear_Liq_Create
  4651)   
  4652)   allocate(RPF_Burdine_Linear_Liq_Create)
  4653)   call RPF_Burdine_Linear_Liq_Create%Init()
  4654)   
  4655) end function RPF_Burdine_Linear_Liq_Create
  4656) 
  4657) ! ************************************************************************** !
  4658) 
  4659) subroutine RPF_Burdine_Linear_Liq_Init(this)
  4660) 
  4661)   ! Initializes the Linear Burdine relative permeability function 
  4662)   ! object
  4663) 
  4664)   implicit none
  4665)   
  4666)   class(rpf_Burdine_Linear_liq_type) :: this
  4667) 
  4668)   call RPFBaseInit(this)
  4669)   
  4670) end subroutine RPF_Burdine_Linear_Liq_Init
  4671) 
  4672) ! ************************************************************************** !
  4673) 
  4674) subroutine RPF_Burdine_Linear_Liq_Verify(this,name,option)
  4675) 
  4676)   use Option_module
  4677) 
  4678)   implicit none
  4679)   
  4680)   class(rpf_Burdine_Linear_liq_type) :: this
  4681)   character(len=MAXSTRINGLENGTH) :: name
  4682)   type(option_type) :: option
  4683)   
  4684)   character(len=MAXSTRINGLENGTH) :: string
  4685)   
  4686)   if (index(name,'PERMEABILITY_FUNCTION') > 0) then
  4687)     string = name
  4688)   else
  4689)     string = trim(name) // 'PERMEABILITY_FUNCTION,BURDINE'
  4690)   endif  
  4691)   call RPFBaseVerify(this,string,option)
  4692)   
  4693) end subroutine RPF_Burdine_Linear_Liq_Verify
  4694) 
  4695) ! ************************************************************************** !
  4696) 
  4697) subroutine RPF_Burdine_Linear_Liq_RelPerm(this,liquid_saturation, &
  4698)                               relative_permeability,dkr_sat,option)
  4699)   ! 
  4700)   ! Computes the relative permeability (and associated derivatives) as a 
  4701)   ! function of saturation
  4702)   ! 
  4703)   !
  4704)   !   
  4705)   ! Author: Bwalya Malama, Heeho Park
  4706)   ! Date: 11/14/14
  4707)   ! 
  4708)   use Option_module
  4709)   use Utility_module
  4710)   
  4711)   implicit none
  4712) 
  4713)   class(rpf_Burdine_Linear_liq_type) :: this
  4714)   PetscReal, intent(in) :: liquid_saturation
  4715)   PetscReal, intent(out) :: relative_permeability
  4716)   PetscReal, intent(out) :: dkr_sat
  4717)   type(option_type), intent(inout) :: option
  4718)   
  4719)   PetscReal :: Se
  4720)   PetscReal :: one_over_m
  4721)   PetscReal :: Se_one_over_m
  4722)   
  4723)   relative_permeability = 0.d0
  4724)   dkr_sat = 0.d0
  4725)   
  4726)   Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr)
  4727)   if (Se >= 1.d0) then
  4728)     relative_permeability = 1.d0
  4729)     return
  4730)   else if (Se <= 0.d0) then
  4731)     relative_permeability = 0.d0
  4732)     return
  4733)   endif
  4734)   
  4735)   relative_permeability = Se
  4736)   dkr_sat = 1.d0 / (1.d0 - this%Sr)
  4737)   
  4738) end subroutine RPF_Burdine_Linear_Liq_RelPerm
  4739) ! End RPF: Burdine, Linear (Liquid)
  4740) 
  4741) ! ************************************************************************** !
  4742) 
  4743) ! Begin Burdine Linear (Gas)
  4744) function RPF_Burdine_Linear_Gas_Create()
  4745) 
  4746)   ! Creates the Linear Burdine gas relative permeability function object
  4747) 
  4748)   implicit none
  4749)   
  4750)   class(rpf_Burdine_Linear_gas_type), pointer :: RPF_Burdine_Linear_Gas_Create
  4751)   
  4752)   allocate(RPF_Burdine_Linear_Gas_Create)
  4753)   call RPF_Burdine_Linear_Gas_Create%Init()
  4754)   
  4755) end function RPF_Burdine_Linear_Gas_Create
  4756) 
  4757) ! ************************************************************************** !
  4758) 
  4759) subroutine RPF_Burdine_Linear_Gas_Init(this)
  4760) 
  4761)   ! Initializes the Linear Burdine gas relative permeability function 
  4762)   ! object
  4763) 
  4764)   implicit none
  4765)   
  4766)   class(rpf_Burdine_Linear_gas_type) :: this
  4767) 
  4768)   call RPFBaseInit(this)
  4769)   this%Srg = UNINITIALIZED_DOUBLE
  4770)   
  4771) end subroutine RPF_Burdine_Linear_Gas_Init
  4772) 
  4773) ! ************************************************************************** !
  4774) 
  4775) subroutine RPF_Burdine_Linear_Gas_Verify(this,name,option)
  4776) 
  4777)   use Option_module
  4778) 
  4779)   implicit none
  4780)   
  4781)   class(rpf_Burdine_Linear_gas_type) :: this
  4782)   character(len=MAXSTRINGLENGTH) :: name
  4783)   type(option_type) :: option
  4784)   
  4785)   character(len=MAXSTRINGLENGTH) :: string 
  4786) 
  4787)   if (index(name,'PERMEABILITY_FUNCTION') > 0) then
  4788)     string = name
  4789)   else
  4790)     string = trim(name) // 'PERMEABILITY_FUNCTION,BURDINE_LINEAR_GAS'
  4791)   endif    
  4792)   call RPFBaseVerify(this,string,option)
  4793)   if (Uninitialized(this%Srg)) then
  4794)     option%io_buffer = UninitializedMessage('GAS_RESIDUAL_SATURATION',string)
  4795)     call printErrMsg(option)
  4796)   endif  
  4797)   
  4798) end subroutine RPF_Burdine_Linear_Gas_Verify
  4799) 
  4800) ! ************************************************************************** !
  4801) 
  4802) subroutine RPF_Burdine_Linear_Gas_RelPerm(this,liquid_saturation, &
  4803)                                      relative_permeability,dkr_sat,option)
  4804)   ! 
  4805)   ! Computes the relative permeability (and associated derivatives) as a 
  4806)   ! function of saturation
  4807)   !
  4808)   !
  4809)   !
  4810)   ! Author: Bwalya Malama, Heeho Park
  4811)   ! Date: 11/14/14
  4812)   !
  4813) 
  4814)   use Option_module
  4815)   
  4816)   implicit none
  4817) 
  4818)   class(rpf_Burdine_Linear_gas_type) :: this
  4819)   PetscReal, intent(in) :: liquid_saturation
  4820)   PetscReal, intent(out) :: relative_permeability
  4821)   PetscReal, intent(out) :: dkr_sat
  4822)   type(option_type), intent(inout) :: option
  4823)   
  4824)   PetscReal :: Se
  4825)   PetscReal :: Seg
  4826)   PetscReal :: liquid_relative_permeability
  4827)   PetscReal :: liquid_dkr_sat
  4828)   PetscReal :: dkr_Se
  4829)   PetscReal :: dSe_sat
  4830)   
  4831)   Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr - this%Srg)
  4832)   
  4833)   relative_permeability = 0.d0
  4834)   dkr_sat = UNINITIALIZED_DOUBLE
  4835)   if (Se >= 1.d0) then
  4836)     relative_permeability = 0.d0
  4837)     return
  4838)   else if (Se <=  0.d0) then
  4839)     relative_permeability = 1.d0
  4840)     return
  4841)   endif
  4842)   
  4843)   Seg = 1.d0 - Se
  4844)   relative_permeability = Seg
  4845)   dkr_Se = -1.d0
  4846)   dSe_sat = 1.d0 / (1.d0 - this%Sr - this%Srg)
  4847)   dkr_sat = dkr_Se * dSe_sat
  4848)   
  4849)   end subroutine RPF_Burdine_Linear_Gas_RelPerm
  4850) ! End Burdine Linear (Gas)
  4851) 
  4852) ! ************************************************************************** !
  4853)   
  4854) ! Begin RPF: BRAGFLO KRP9 (Liquid)
  4855) function RPF_BRAGFLO_KRP9_Liq_Create()
  4856) 
  4857)   ! Creates the Linear Burdine relative permeability function object
  4858) 
  4859)   implicit none
  4860)   
  4861)   class(rpf_BRAGFLO_KRP9_liq_type), pointer :: RPF_BRAGFLO_KRP9_Liq_Create
  4862)   
  4863)   allocate(RPF_BRAGFLO_KRP9_Liq_Create)
  4864)   call RPF_BRAGFLO_KRP9_Liq_Create%Init()
  4865)   
  4866) end function RPF_BRAGFLO_KRP9_Liq_Create
  4867) 
  4868) ! ************************************************************************** !
  4869) 
  4870) subroutine RPF_BRAGFLO_KRP9_Liq_Init(this)
  4871) 
  4872)   ! Initializes the Linear Burdine relative permeability function 
  4873)   ! object
  4874) 
  4875)   implicit none
  4876)   
  4877)   class(rpf_BRAGFLO_KRP9_liq_type) :: this
  4878) 
  4879)   call RPFBaseInit(this)
  4880)   
  4881) end subroutine RPF_BRAGFLO_KRP9_Liq_Init
  4882) 
  4883) ! ************************************************************************** !
  4884) 
  4885) subroutine RPF_BRAGFLO_KRP9_Liq_Verify(this,name,option)
  4886) 
  4887)   use Option_module
  4888) 
  4889)   implicit none
  4890)   
  4891)   class(rpf_BRAGFLO_KRP9_liq_type) :: this
  4892)   character(len=MAXSTRINGLENGTH) :: name
  4893)   type(option_type) :: option
  4894)   
  4895)   character(len=MAXSTRINGLENGTH) :: string
  4896)   
  4897)   if (index(name,'PERMEABILITY_FUNCTION') > 0) then
  4898)     string = name
  4899)   else
  4900)     string = trim(name) // 'PERMEABILITY_FUNCTION,BRAGFLO_KRP9'
  4901)   endif  
  4902)   call RPFBaseVerify(this,string,option)
  4903)   
  4904) end subroutine RPF_BRAGFLO_KRP9_Liq_Verify
  4905) 
  4906) ! ************************************************************************** !
  4907) 
  4908) subroutine RPF_BRAGFLO_KRP9_Liq_RelPerm(this,liquid_saturation, &
  4909)                               relative_permeability,dkr_sat,option)
  4910)   ! 
  4911)   ! Computes the relative permeability (and associated derivatives) as a 
  4912)   ! function of saturation
  4913)   ! based on experimental measurements and analyses done by Vauclin et al.
  4914)   ! as discussed by Moridis and Pruess. 
  4915)   ! 14.	Moridis, G. J., and K. Pruess.  1992.  TOUGH Simulations of 
  4916)   ! Updegraff\92s Set of Fluid and Heat Flow Problems.  LBL-32611, ERMS# 138458. 
  4917)   ! Berkeley, CA:  Lawrence Berkeley Laboratory.
  4918)   ! Author: Heeho Park
  4919)   ! Date: 03/26/15
  4920)   ! 
  4921)   use Option_module
  4922)   use Utility_module
  4923)   
  4924)   implicit none
  4925) 
  4926)   class(rpf_BRAGFLO_KRP9_liq_type) :: this
  4927)   PetscReal, intent(in) :: liquid_saturation
  4928)   PetscReal, intent(out) :: relative_permeability
  4929)   PetscReal, intent(out) :: dkr_sat
  4930)   type(option_type), intent(inout) :: option
  4931)   
  4932)   PetscReal :: Se
  4933)   PetscReal :: one_over_m
  4934)   PetscReal :: Se_one_over_m
  4935)   
  4936)   relative_permeability = 0.d0
  4937)   print *, 'RPF_BRAGFLO_KRP9_Liq_RelPerm not validated'
  4938)   stop
  4939)   ! initialize to derivative to NaN so that not mistakenly used.
  4940)   dkr_sat = 0.d0
  4941)   dkr_sat = dkr_sat / 0.d0
  4942)   dkr_sat = dkr_sat * 0.d0
  4943)   
  4944)   Se = (1.d0-liquid_saturation)/(liquid_saturation)
  4945)   if (liquid_saturation <= this%Sr) then
  4946)     relative_permeability = 0.d0
  4947)     return
  4948)   endif
  4949)   
  4950)   relative_permeability = 1.d0/(1.d0+28.768353d0*Se**1.7241379d0)
  4951)   
  4952) end subroutine RPF_BRAGFLO_KRP9_Liq_RelPerm
  4953) ! End RPF: BRAGFLO KRP9 (Liquid)
  4954) 
  4955) ! ************************************************************************** !
  4956) 
  4957) ! Begin BRAGFLO KRP9 (Gas)
  4958) function RPF_BRAGFLO_KRP9_Gas_Create()
  4959) 
  4960)   ! Creates the Linear Burdine gas relative permeability function object
  4961) 
  4962)   implicit none
  4963)   
  4964)   class(rpf_BRAGFLO_KRP9_gas_type), pointer :: RPF_BRAGFLO_KRP9_Gas_Create
  4965)   
  4966)   allocate(RPF_BRAGFLO_KRP9_Gas_Create)
  4967)   call RPF_BRAGFLO_KRP9_Gas_Create%Init()
  4968)   
  4969) end function RPF_BRAGFLO_KRP9_Gas_Create
  4970) 
  4971) ! ************************************************************************** !
  4972) 
  4973) subroutine RPF_BRAGFLO_KRP9_Gas_Init(this)
  4974) 
  4975)   ! Initializes the Linear Burdine gas relative permeability function 
  4976)   ! object
  4977) 
  4978)   implicit none
  4979)   
  4980)   class(rpf_BRAGFLO_KRP9_gas_type) :: this
  4981) 
  4982)   call RPFBaseInit(this)
  4983)   
  4984) end subroutine RPF_BRAGFLO_KRP9_Gas_Init
  4985) 
  4986) ! ************************************************************************** !
  4987) 
  4988) subroutine RPF_BRAGFLO_KRP9_Gas_Verify(this,name,option)
  4989) 
  4990)   use Option_module
  4991) 
  4992)   implicit none
  4993)   
  4994)   class(rpf_BRAGFLO_KRP9_gas_type) :: this
  4995)   character(len=MAXSTRINGLENGTH) :: name
  4996)   type(option_type) :: option
  4997)   
  4998)   character(len=MAXSTRINGLENGTH) :: string 
  4999) 
  5000)   if (index(name,'PERMEABILITY_FUNCTION') > 0) then
  5001)     string = name
  5002)   else
  5003)     string = trim(name) // 'PERMEABILITY_FUNCTION,BURDINE_LINEAR_GAS'
  5004)   endif    
  5005)   call RPFBaseVerify(this,string,option)
  5006)   
  5007) end subroutine RPF_BRAGFLO_KRP9_Gas_Verify
  5008) 
  5009) ! ************************************************************************** !
  5010) 
  5011) subroutine RPF_BRAGFLO_KRP9_Gas_RelPerm(this,liquid_saturation, &
  5012)                                      relative_permeability,dkr_sat,option)
  5013)   ! 
  5014)   ! Computes the relative permeability (and associated derivatives) as a 
  5015)   ! function of saturation
  5016)   ! based on experimental measurements and analyses done by Vauclin et al.
  5017)   ! as discussed by Moridis and Pruess.  
  5018)   ! 14.	Moridis, G. J., and K. Pruess.  1992.  TOUGH Simulations of 
  5019)   ! Updegraff\92s Set of Fluid and Heat Flow Problems.  LBL-32611, ERMS# 138458. 
  5020)   ! Berkeley, CA:  Lawrence Berkeley Laboratory.
  5021)   ! Author: Heeho Park
  5022)   ! Date: 03/26/15
  5023)   ! 
  5024) 
  5025)   use Option_module
  5026)   
  5027)   implicit none
  5028) 
  5029)   class(rpf_BRAGFLO_KRP9_gas_type) :: this
  5030)   PetscReal, intent(in) :: liquid_saturation
  5031)   PetscReal, intent(out) :: relative_permeability
  5032)   PetscReal, intent(out) :: dkr_sat
  5033)   type(option_type), intent(inout) :: option
  5034)   
  5035)   PetscReal :: Se
  5036)   PetscReal :: Seg
  5037)   PetscReal :: liquid_relative_permeability
  5038)   PetscReal :: liquid_dkr_sat
  5039)   PetscReal :: dkr_Se
  5040) 
  5041)   print *, 'RPF_BRAGFLO_KRP9_Gas_RelPerm not validated'
  5042)   stop
  5043)   ! initialize to derivative to NaN so that not mistakenly used.
  5044)   dkr_sat = 0.d0
  5045)   dkr_sat = dkr_sat / 0.d0
  5046)   dkr_sat = dkr_sat * 0.d0
  5047)   
  5048) 
  5049)   Se = (1.d0-liquid_saturation)/(liquid_saturation)
  5050)   if (liquid_saturation <= this%Sr) then
  5051)     relative_permeability = 1.d0
  5052)     return
  5053)   endif
  5054)   
  5055)   call RPF_BRAGFLO_KRP9_Liq_RelPerm(this,liquid_saturation, &
  5056)                         liquid_relative_permeability, &
  5057)                         liquid_dkr_sat,option)
  5058)   
  5059)   relative_permeability = 1.d0 - liquid_relative_permeability
  5060)   dkr_Se = -1.d0 * liquid_dkr_sat
  5061)   
  5062) end subroutine RPF_BRAGFLO_KRP9_Gas_RelPerm
  5063) ! End RPF: BRAGFLO KRP9 (Gas)
  5064) 
  5065) ! ************************************************************************** !
  5066) 
  5067) ! Begin RPF: BRAGFLO KRP4 (Liq)
  5068) function RPF_BRAGFLO_KRP4_Liq_Create()
  5069) 
  5070)   ! Creates the KRP4 or BC_Burdine liq relative permeability function object
  5071) 
  5072)   implicit none
  5073)   
  5074)   class(rpf_BRAGFLO_KRP4_liq_type), pointer :: RPF_BRAGFLO_KRP4_Liq_Create
  5075)   
  5076)   allocate(RPF_BRAGFLO_KRP4_Liq_Create)
  5077)   call RPF_BRAGFLO_KRP4_Liq_Create%Init()
  5078)   
  5079) end function RPF_BRAGFLO_KRP4_Liq_Create
  5080) ! End RPF: BRAGFLO KRP4 (Liq)
  5081) 
  5082) ! ************************************************************************** !
  5083) 
  5084) ! Begin RPF: BRAGFLO KRP4 (Gas)
  5085) function RPF_BRAGFLO_KRP4_Gas_Create()
  5086) 
  5087)   ! Creates the KRP4 or BC_Burdine gas relative permeability function object
  5088) 
  5089)   implicit none
  5090)   
  5091)   class(rpf_BRAGFLO_KRP4_gas_type), pointer :: RPF_BRAGFLO_KRP4_Gas_Create
  5092)   
  5093)   allocate(RPF_BRAGFLO_KRP4_Gas_Create)
  5094)   call RPF_BRAGFLO_KRP4_Gas_Create%Init()
  5095)   
  5096) end function RPF_BRAGFLO_KRP4_Gas_Create
  5097) ! End RPF: BRAGFLO KRP4 (Gas)
  5098) 
  5099) ! ************************************************************************** !
  5100) 
  5101) subroutine RPF_BRAGFLO_KRP4_Gas_Init(this)
  5102) 
  5103)   ! Initializes the Brooks-Corey Burdine gas relative permeability function 
  5104)   ! object
  5105) 
  5106)   implicit none
  5107)   
  5108)   class(rpf_BRAGFLO_KRP4_gas_type) :: this
  5109) 
  5110)   call RPFBaseInit(this)
  5111)   this%Srg = UNINITIALIZED_DOUBLE
  5112)   
  5113) end subroutine RPF_BRAGFLO_KRP4_Gas_Init
  5114) 
  5115) ! ************************************************************************** !
  5116) 
  5117) subroutine RPF_BRAGFLO_KRP4_Gas_Verify(this,name,option)
  5118) 
  5119)   use Option_module
  5120) 
  5121)   implicit none
  5122)   
  5123)   class(rpf_BRAGFLO_KRP4_gas_type) :: this
  5124)   character(len=MAXSTRINGLENGTH) :: name
  5125)   type(option_type) :: option
  5126)   
  5127)   character(len=MAXSTRINGLENGTH) :: string 
  5128) 
  5129)   if (index(name,'PERMEABILITY_FUNCTION') > 0) then
  5130)     string = name
  5131)   else
  5132)     string = trim(name) // 'PERMEABILITY_FUNCTION,BRAGFLO_KRP4_GAS'
  5133)   endif    
  5134)   call RPFBaseVerify(this,string,option)
  5135)   if (Uninitialized(this%Srg)) then
  5136)     option%io_buffer = UninitializedMessage('GAS_RESIDUAL_SATURATION',string)
  5137)     call printErrMsg(option)
  5138)   endif  
  5139)   
  5140) end subroutine RPF_BRAGFLO_KRP4_Gas_Verify
  5141) 
  5142) ! ************************************************************************** !
  5143) 
  5144) subroutine RPF_BRAGFLO_KRP4_Gas_RelPerm(this,liquid_saturation, &
  5145)                                      relative_permeability,dkr_sat,option)
  5146)   ! 
  5147)   ! Computes the relative permeability (and associated derivatives) as a 
  5148)   ! function of saturation
  5149)   ! 
  5150)   ! (1) Chen, J., J.W. Hopmans, M.E. Grismer (1999) "Parameter estimation of
  5151)   !     of two-fluid capillary pressure-saturation and permeability functions",
  5152)   !     Advances in Water Resources, Vol. 22, No. 5, pp 479-493,
  5153)   !     http://dx.doi.org/10.1016/S0309-1708(98)00025-6.
  5154)   !   
  5155)   ! Author: Glenn Hammond
  5156)   ! Date: 12/11/07, 09/23/14
  5157)   ! 
  5158)   use Option_module
  5159)   
  5160)   implicit none
  5161) 
  5162)   class(rpf_BRAGFLO_KRP4_gas_type) :: this
  5163)   PetscReal, intent(in) :: liquid_saturation
  5164)   PetscReal, intent(out) :: relative_permeability
  5165)   PetscReal, intent(out) :: dkr_sat
  5166)   type(option_type), intent(inout) :: option
  5167)   
  5168)   PetscReal :: Se
  5169)   PetscReal :: Seg
  5170)   PetscReal :: gas_saturation
  5171)   PetscReal :: dkr_Se
  5172)   PetscReal :: dSe_sat
  5173)   
  5174)   gas_saturation = 1.0d0 - liquid_saturation
  5175)   
  5176)   relative_permeability = 0.d0
  5177)   print *, 'RPF_BRAGFLO_KRP4_Gas_RelPerm not validated'
  5178)   stop
  5179)   ! initialize to derivative to NaN so that not mistakenly used.
  5180)   dkr_sat = 0.d0
  5181)   dkr_sat = dkr_sat / 0.d0
  5182)   dkr_sat = dkr_sat * 0.d0
  5183)   
  5184) 
  5185)   if (gas_saturation <= this%Srg) then
  5186)     relative_permeability = 0.0d0
  5187)   else if (liquid_saturation > this%Sr) then
  5188)     Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr - this%Srg)
  5189)     Seg = 1.d0 - Se
  5190)         ! reference #1
  5191)     relative_permeability = Seg*Seg*(1.d0-Se**(1.d0+2.d0/this%lambda))
  5192)     ! Mathematica Analytical solution (Heeho Park)
  5193)     dkr_Se = -(1.d0+2.d0/this%lambda)*Seg**2.d0*Se**(2.d0/this%lambda) &
  5194)              - 2.d0*Seg*(1.d0-Se**(1.d0+2.d0/this%lambda))
  5195)     dSe_sat = 1.d0 / (1.d0 - this%Sr - this%Srg)
  5196)     dkr_sat = dkr_Se * dSe_sat
  5197)   else
  5198)     relative_permeability = 1.0d0
  5199)   endif
  5200)   
  5201) end subroutine RPF_BRAGFLO_KRP4_Gas_RelPerm
  5202) ! End RPF: Burdine, Brooks-Corey (Gas)
  5203) 
  5204) ! ************************************************************************** !
  5205)   
  5206) ! Begin RPF: BRAGFLO KRP11 (Liquid)
  5207) function RPF_BRAGFLO_KRP11_Liq_Create()
  5208) 
  5209)   ! Creates the Linear Burdine relative permeability function object
  5210) 
  5211)   implicit none
  5212)   
  5213)   class(rpf_BRAGFLO_KRP11_liq_type), pointer :: RPF_BRAGFLO_KRP11_Liq_Create
  5214)   
  5215)   allocate(RPF_BRAGFLO_KRP11_Liq_Create)
  5216)   call RPF_BRAGFLO_KRP11_Liq_Create%Init()
  5217)   
  5218) end function RPF_BRAGFLO_KRP11_Liq_Create
  5219) 
  5220) ! ************************************************************************** !
  5221) 
  5222) subroutine RPF_BRAGFLO_KRP11_Liq_Init(this)
  5223) 
  5224)   ! Initializes the Linear Burdine relative permeability function 
  5225)   ! object
  5226) 
  5227)   implicit none
  5228)   
  5229)   class(rpf_BRAGFLO_KRP11_liq_type) :: this
  5230) 
  5231)   call RPFBaseInit(this)
  5232)   
  5233) end subroutine RPF_BRAGFLO_KRP11_Liq_Init
  5234) 
  5235) ! ************************************************************************** !
  5236) 
  5237) subroutine RPF_BRAGFLO_KRP11_Liq_Verify(this,name,option)
  5238) 
  5239)   use Option_module
  5240) 
  5241)   implicit none
  5242)   
  5243)   class(rpf_BRAGFLO_KRP11_liq_type) :: this
  5244)   character(len=MAXSTRINGLENGTH) :: name
  5245)   type(option_type) :: option
  5246)   
  5247)   character(len=MAXSTRINGLENGTH) :: string
  5248)   
  5249)   if (index(name,'PERMEABILITY_FUNCTION') > 0) then
  5250)     string = name
  5251)   else
  5252)     string = trim(name) // 'PERMEABILITY_FUNCTION,BRAGFLO_KRP11'
  5253)   endif  
  5254)   call RPFBaseVerify(this,string,option)
  5255)   if (Uninitialized(this%Srg)) then
  5256)     option%io_buffer = UninitializedMessage('GAS_RESIDUAL_SATURATION',string)
  5257)     call printErrMsg(option)
  5258)   endif
  5259)   if (Uninitialized(this%tolc)) then
  5260)     option%io_buffer = UninitializedMessage('TOLC',string)
  5261)     call printErrMsg(option)
  5262)   endif
  5263) 
  5264) end subroutine RPF_BRAGFLO_KRP11_Liq_Verify
  5265) 
  5266) ! ************************************************************************** !
  5267) 
  5268) subroutine RPF_BRAGFLO_KRP11_Liq_RelPerm(this,liquid_saturation, &
  5269)                               relative_permeability,dkr_sat,option)
  5270)   ! 
  5271)   ! KRP = 11 BRAGFLO relative permeability model
  5272)   ! the relative permeabilities decrease from 1 to zero linearly between
  5273)   ! the residual saturations (brine and gas) and the residual saturation
  5274)   ! plus a tolerance.
  5275)   !
  5276)   ! Author: Heeho Park
  5277)   ! Date: 03/26/15
  5278)   ! 
  5279)   use Option_module
  5280)   use Utility_module
  5281)   
  5282)   implicit none
  5283) 
  5284)   class(rpf_BRAGFLO_KRP11_liq_type) :: this
  5285)   PetscReal, intent(in) :: liquid_saturation
  5286)   PetscReal, intent(out) :: relative_permeability
  5287)   PetscReal, intent(out) :: dkr_sat
  5288)   type(option_type), intent(inout) :: option
  5289)   
  5290)   PetscReal :: gas_saturation
  5291)   PetscReal :: tol
  5292)   
  5293)   gas_saturation = 1.d0 - liquid_saturation
  5294)   
  5295)   relative_permeability = 0.d0
  5296)   print *, 'RPF_BRAGFLO_KRP11_Liq_RelPerm not validated'
  5297)   stop
  5298)   ! initialize to derivative to NaN so that not mistakenly used.
  5299)   dkr_sat = 0.d0
  5300)   dkr_sat = dkr_sat / 0.d0
  5301)   dkr_sat = dkr_sat * 0.d0
  5302)   
  5303)   tol = this%tolc * (1 - this%Sr - this%Srg)
  5304)   
  5305)   if (liquid_saturation <= this%Sr) then
  5306)     relative_permeability = 0.d0
  5307)   else if (gas_saturation <= this%Srg) then
  5308)     relative_permeability = 1.d0
  5309)   else if (liquid_saturation <= this%Sr+tol) then
  5310)     relative_permeability = (liquid_saturation - this%Sr)/tol
  5311)   else if (gas_saturation <= this%Srg+tol) then
  5312)     relative_permeability = 1.d0
  5313)   else
  5314)     relative_permeability = 1.d0
  5315)   endif
  5316)     
  5317) end subroutine RPF_BRAGFLO_KRP11_Liq_RelPerm
  5318) ! End RPF: BRAGFLO KRP11 (Liquid)
  5319) 
  5320) ! ************************************************************************** !
  5321) 
  5322) ! Begin BRAGFLO KRP11 (Gas)
  5323) function RPF_BRAGFLO_KRP11_Gas_Create()
  5324) 
  5325)   ! Creates the Linear Burdine gas relative permeability function object
  5326) 
  5327)   implicit none
  5328)   
  5329)   class(rpf_BRAGFLO_KRP11_gas_type), pointer :: RPF_BRAGFLO_KRP11_Gas_Create
  5330)   
  5331)   allocate(RPF_BRAGFLO_KRP11_Gas_Create)
  5332)   call RPF_BRAGFLO_KRP11_Gas_Create%Init()
  5333)   
  5334) end function RPF_BRAGFLO_KRP11_Gas_Create
  5335) 
  5336) ! ************************************************************************** !
  5337) 
  5338) subroutine RPF_BRAGFLO_KRP11_Gas_RelPerm(this,liquid_saturation, &
  5339)                                      relative_permeability,dkr_sat,option)
  5340)   ! 
  5341)   ! KRP = 11 BRAGFLO relative permeability model
  5342)   ! the relative permeabilities decrease from 1 to zero linearly between
  5343)   ! the residual saturations (brine and gas) and the residual saturation
  5344)   ! plus a tolerance.
  5345)   !
  5346)   ! Author: Heeho Park
  5347)   ! Date: 03/26/15
  5348)   ! 
  5349) 
  5350)   use Option_module
  5351)   
  5352)   implicit none
  5353) 
  5354)   class(rpf_BRAGFLO_KRP11_gas_type) :: this
  5355)   PetscReal, intent(in) :: liquid_saturation
  5356)   PetscReal, intent(out) :: relative_permeability
  5357)   PetscReal, intent(out) :: dkr_sat
  5358)   type(option_type), intent(inout) :: option
  5359)   
  5360)   PetscReal :: gas_saturation
  5361)   PetscReal :: tol
  5362)   
  5363)   gas_saturation = 1.d0 - liquid_saturation
  5364)   
  5365)   relative_permeability = 0.d0
  5366)   print *, 'RPF_BRAGFLO_KRP11_Gas_RelPerm not validated'
  5367)   stop
  5368)   ! initialize to derivative to NaN so that not mistakenly used.
  5369)   dkr_sat = 0.d0
  5370)   dkr_sat = dkr_sat / 0.d0
  5371)   dkr_sat = dkr_sat * 0.d0
  5372)   
  5373)   
  5374)   tol = this%tolc * (1 - this%Sr - this%Srg)
  5375)   
  5376)   if (liquid_saturation <= this%Sr) then
  5377)     relative_permeability = 1.d0
  5378)   else if (gas_saturation <= this%Srg) then
  5379)     relative_permeability = 0.d0
  5380)   else if (liquid_saturation <= this%Sr+tol) then
  5381)     relative_permeability = 1.d0
  5382)   else if (gas_saturation <= this%Srg+tol) then
  5383)     relative_permeability = (gas_saturation - this%Srg)/tol
  5384)   else
  5385)     relative_permeability = 1.d0
  5386)   endif
  5387)   
  5388)   end subroutine RPF_BRAGFLO_KRP11_Gas_RelPerm
  5389) ! End RPF: BRAGFLO KRP11 (Gas)
  5390) 
  5391) ! ************************************************************************** !
  5392) 
  5393) ! Begin RPF: BRAGFLO KRP12 (Liq)
  5394) function RPF_BRAGFLO_KRP12_Liq_Create()
  5395) 
  5396)   ! Creates the KRP12 or BC_Burdine liq relative permeability function object
  5397) 
  5398)   implicit none
  5399)   
  5400)   class(rpf_BRAGFLO_KRP12_liq_type), pointer :: RPF_BRAGFLO_KRP12_Liq_Create
  5401)   
  5402)   allocate(RPF_BRAGFLO_KRP12_Liq_Create)
  5403)   call RPF_BRAGFLO_KRP12_Liq_Create%Init()
  5404)   
  5405) end function RPF_BRAGFLO_KRP12_Liq_Create
  5406) ! End RPF: BRAGFLO KRP12 (Liq)
  5407) 
  5408) ! ************************************************************************** !
  5409) 
  5410) subroutine RPF_BRAGFLO_KRP12_Liq_RelPerm(this,liquid_saturation, &
  5411)                               relative_permeability,dkr_sat,option)
  5412)   ! 
  5413)   ! Computes the relative permeability (and associated derivatives) as a 
  5414)   ! function of saturation
  5415)   ! 
  5416)   ! Modified Brooks-Corey model KRP = 12 in BRAGFLO
  5417)   !   
  5418)   ! Author: Heeho Park
  5419)   ! Date: 11/13/15
  5420)   ! 
  5421)   use Option_module
  5422)   
  5423)   implicit none
  5424) 
  5425)   class(rpf_BRAGFLO_KRP12_liq_type) :: this
  5426)   PetscReal, intent(in) :: liquid_saturation
  5427)   PetscReal, intent(out) :: relative_permeability
  5428)   PetscReal, intent(out) :: dkr_sat
  5429)   type(option_type), intent(inout) :: option
  5430)   
  5431)   PetscReal :: Se
  5432)   PetscReal :: power
  5433)   PetscReal :: dkr_Se
  5434) 
  5435)   relative_permeability = 0.d0
  5436)   print *, 'RPF_BRAGFLO_KRP12_Liq_RelPerm not validated'
  5437)   stop
  5438)   ! initialize to derivative to NaN so that not mistakenly used.
  5439)   dkr_sat = 0.d0
  5440)   dkr_sat = dkr_sat / 0.d0
  5441)   dkr_sat = dkr_sat * 0.d0
  5442)   
  5443)   Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr)
  5444)   Se = max(min(Se,1.0d0),0.0d0)
  5445)   
  5446)   if (Se >= 1.d0) then
  5447)     relative_permeability = 1.d0
  5448)     return
  5449)   else if (Se <= 0.d0) then
  5450)     relative_permeability = 0.d0
  5451)     return
  5452)   else if (Se < this%Sr) then
  5453)     Se = this%Sr
  5454)   endif
  5455)   
  5456)   ! reference #1
  5457)   power = 3.d0+2.d0/this%lambda
  5458)   relative_permeability = Se**power
  5459)   dkr_Se = power*relative_permeability/Se          
  5460)   
  5461) end subroutine RPF_BRAGFLO_KRP12_Liq_RelPerm
  5462) ! End RPF: Burdine, Brooks-Corey (Liquid)
  5463)   
  5464) ! ************************************************************************** !
  5465) 
  5466) ! Begin RPF: BRAGFLO KRP12 (Gas)
  5467) function RPF_BRAGFLO_KRP12_Gas_Create()
  5468) 
  5469)   ! Creates the KRP12 or BC_Burdine gas relative permeability function object
  5470) 
  5471)   implicit none
  5472)   
  5473)   class(rpf_BRAGFLO_KRP12_gas_type), pointer :: RPF_BRAGFLO_KRP12_Gas_Create
  5474)   
  5475)   allocate(RPF_BRAGFLO_KRP12_Gas_Create)
  5476)   call RPF_BRAGFLO_KRP12_Gas_Create%Init()
  5477)   
  5478) end function RPF_BRAGFLO_KRP12_Gas_Create
  5479) ! End RPF: BRAGFLO KRP12 (Gas)
  5480) 
  5481) ! ************************************************************************** !
  5482) 
  5483) subroutine RPF_BRAGFLO_KRP12_Gas_RelPerm(this,liquid_saturation, &
  5484)                                      relative_permeability,dkr_sat,option)
  5485)   ! 
  5486)   ! Computes the relative permeability (and associated derivatives) as a 
  5487)   ! function of saturation
  5488)   ! 
  5489)   ! Modified Brooks-Corey model KRP = 12 in BRAGFLO
  5490)   !   
  5491)   ! Author:  Heeho Park
  5492)   ! Date: 11/13/15
  5493)   ! 
  5494)   use Option_module
  5495)   
  5496)   implicit none
  5497) 
  5498)   class(rpf_BRAGFLO_KRP12_gas_type) :: this
  5499)   PetscReal, intent(in) :: liquid_saturation
  5500)   PetscReal, intent(out) :: relative_permeability
  5501)   PetscReal, intent(out) :: dkr_sat
  5502)   type(option_type), intent(inout) :: option
  5503)   
  5504)   PetscReal :: Se
  5505)   PetscReal :: Seg
  5506)   PetscReal :: gas_saturation
  5507)   PetscReal :: dkr_Se
  5508)   
  5509)   gas_saturation = 1.0d0 - liquid_saturation
  5510)   
  5511)   relative_permeability = 0.d0
  5512)   print *, 'RPF_BRAGFLO_KRP12_Gas_RelPerm not validated'
  5513)   stop
  5514)   ! initialize to derivative to NaN so that not mistakenly used.
  5515)   dkr_sat = 0.d0
  5516)   dkr_sat = dkr_sat / 0.d0
  5517)   dkr_sat = dkr_sat * 0.d0
  5518) 
  5519)   if (gas_saturation <= this%Srg) then
  5520)     relative_permeability = 0.0d0
  5521)   else if (liquid_saturation > this%Sr) then
  5522)     Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sr - this%Srg)
  5523)     Se = max(min(Se,1.0d0),0.0d0)
  5524)     Seg = 1.d0 - Se
  5525)     if (Se < this%Sr) then
  5526)        Se = this%Sr
  5527)        Seg = 1.d0 - Se
  5528)     else if (Seg < this%Srg) then
  5529)        Seg = this%Srg
  5530)        Se = 1.d0 - Seg
  5531)     endif
  5532)         ! reference #1
  5533)     relative_permeability = Seg*Seg*(1.d0-Se**(1.d0+2.d0/this%lambda))
  5534)     ! Mathematica Analytical solution (Heeho Park)
  5535)     dkr_Se = -(1.d0+2.d0/this%lambda)*Seg**2.d0*Se**(2.d0/this%lambda) &
  5536)              - 2.d0*Seg*(1.d0-Se**(1.d0+2.d0/this%lambda))
  5537)   else
  5538)     relative_permeability = 1.0d0
  5539)   endif
  5540)   
  5541) end subroutine RPF_BRAGFLO_KRP12_Gas_RelPerm
  5542) ! End RPF: Burdine, Brooks-Corey (Gas)
  5543)   
  5544) ! ************************************************************************** !
  5545)   
  5546) ! Begin RPF: TOUGH2, Linear (Oil) 
  5547) function RPF_TOUGH2_Linear_Oil_Create()
  5548) 
  5549)   ! Creates the TOUGH2 Linear oil relative permeability function object
  5550)   ! Author: Paolo Orsini (OGS)
  5551)   ! Date: 10/19/2015
  5552) 
  5553)   class(rpf_TOUGH2_Linear_oil_type), pointer :: RPF_TOUGH2_Linear_Oil_Create
  5554) 
  5555)   allocate(RPF_TOUGH2_Linear_Oil_Create)
  5556)   call RPF_TOUGH2_Linear_Oil_Create%Init()
  5557) 
  5558) end function RPF_TOUGH2_Linear_Oil_Create
  5559) 
  5560) ! ************************************************************************** !
  5561) 
  5562) subroutine RPF_TOUGH2_Linear_Oil_Init(this)
  5563) 
  5564)   ! Initializes the TOUGH2 Linear Oil relative permeability function 
  5565)   ! object
  5566)   ! Author: Paolo Orsini (OGS)
  5567)   ! Date: 10/19/2015
  5568) 
  5569)   implicit none
  5570)   
  5571)   class(rpf_TOUGH2_Linear_oil_type) :: this
  5572) 
  5573)   call RPFBaseInit(this)
  5574)   this%Sro = UNINITIALIZED_DOUBLE
  5575)   
  5576) end subroutine RPF_TOUGH2_Linear_Oil_Init
  5577) 
  5578) ! ************************************************************************** !
  5579) 
  5580) subroutine RPF_TOUGH2_Linear_Oil_Verify(this,name,option)
  5581) 
  5582)   use Option_module
  5583) 
  5584)   implicit none
  5585)   
  5586)   class(rpf_TOUGH2_Linear_oil_type) :: this
  5587)   character(len=MAXSTRINGLENGTH) :: name
  5588)   type(option_type) :: option
  5589)   
  5590)   character(len=MAXSTRINGLENGTH) :: string 
  5591) 
  5592)   if (index(name,'PERMEABILITY_FUNCTION') > 0) then
  5593)     string = name
  5594)   else
  5595)     string = trim(name) // 'PERMEABILITY_FUNCTION,TOUGH2_LINEAR_OIL'
  5596)   endif    
  5597)   call RPFBaseVerify(this,string,option)
  5598)   if (Uninitialized(this%Sro)) then
  5599)     option%io_buffer = UninitializedMessage('OIL_RESIDUAL_SATURATION',string)
  5600)     call printErrMsg(option)
  5601)   endif  
  5602)   
  5603) end subroutine RPF_TOUGH2_Linear_Oil_Verify
  5604) 
  5605) ! ************************************************************************** !
  5606) 
  5607) subroutine RPF_TOUGH2_Linear_Oil_RelPerm(this,liquid_saturation, &
  5608)                                      relative_permeability,dkr_sat,option)
  5609)   ! 
  5610)   ! Computes the relative permeability (and associated derivatives) as a 
  5611)   ! function of saturation
  5612)   !
  5613)   ! Author: Paolo Orsini (OGS)
  5614)   ! Date: 10/19/2015
  5615) 
  5616) 
  5617)   use Option_module
  5618)   
  5619)   implicit none
  5620) 
  5621)   class(rpf_TOUGH2_Linear_oil_type) :: this
  5622)   PetscReal, intent(in) :: liquid_saturation
  5623)   PetscReal, intent(out) :: relative_permeability
  5624)   PetscReal, intent(out) :: dkr_sat
  5625)   type(option_type), intent(inout) :: option
  5626)   
  5627)   PetscReal :: So
  5628)   PetscReal :: Se
  5629)   PetscReal :: Seo
  5630)   PetscReal :: liquid_relative_permeability
  5631)   PetscReal :: liquid_dkr_sat
  5632)   
  5633)   ! initialize to derivative to NaN so that not mistakenly used.
  5634)   dkr_sat = 0.d0
  5635)   dkr_sat = dkr_sat / 0.d0
  5636)   dkr_sat = dkr_sat * 0.d0
  5637) 
  5638)   So = 1.d0 - liquid_saturation
  5639) 
  5640)   Seo = (So - this%Sro) / (1.d0 - this%Sro)
  5641) 
  5642)   if (Seo >= 1.d0) then
  5643)     relative_permeability = 1.d0
  5644)     return
  5645)   else if (Seo <=  0.d0) then
  5646)     relative_permeability = 0.d0
  5647)     return
  5648)   endif
  5649) 
  5650)   relative_permeability = Seo
  5651) 
  5652) end subroutine RPF_TOUGH2_Linear_Oil_RelPerm
  5653) ! End RPF: TOUGH2, Linear (Oil)
  5654) 
  5655) ! ************************************************************************** !
  5656) 
  5657) !Beginning RPF Modified Brooks-Corey for liq and oil phase (RPF_Mod_BC_Oil)
  5658) 
  5659) !  procedure, public :: Init => RPF_Mod_BC_Oil_Init 
  5660) !  procedure, public :: Verify => RPF_Mod_BC_Oil_Verify
  5661) !  procedure, public :: SetupPolynomials => RPF_Mod_BC_SetupPolynomials
  5662) !  procedure, public :: RelativePermeability => RPF_Mod_BC_Oil_RelPerm
  5663) 
  5664) function RPF_Mod_BC_Liq_Create()
  5665) 
  5666)   ! Creates the Modified BC Oil relative permeability function object
  5667)   ! Author: Paolo Orsini (OGS)
  5668)   ! Date: 02/20/2016
  5669) 
  5670)   class(rpf_mod_BC_liq_type), pointer :: RPF_Mod_BC_Liq_Create
  5671) 
  5672)   allocate(RPF_Mod_BC_Liq_Create)
  5673)   call RPF_Mod_BC_Liq_Create%Init()
  5674) 
  5675) end function RPF_Mod_BC_Liq_Create
  5676) 
  5677) ! ************************************************************************** !
  5678) 
  5679) function RPF_Mod_BC_Oil_Create()
  5680) 
  5681)   ! Creates the Modified BC Oil relative permeability function object
  5682)   ! Author: Paolo Orsini (OGS)
  5683)   ! Date: 02/20/2016
  5684) 
  5685)   class(rpf_mod_BC_oil_type), pointer :: RPF_Mod_BC_Oil_Create
  5686) 
  5687)   allocate(RPF_Mod_BC_Oil_Create)
  5688)   call RPF_Mod_BC_Oil_Create%Init()
  5689) 
  5690) end function RPF_Mod_BC_Oil_Create
  5691) 
  5692) ! ************************************************************************** !
  5693) 
  5694) !subroutine RPF_Mod_BC_Oil_Init(this)
  5695) subroutine RPF_Mod_BC_Init(this)
  5696) 
  5697)   ! Initializes the Modified BC Oil relative permeability function object 
  5698)   ! object
  5699)   ! Author: Paolo Orsini (OGS)
  5700)   ! Date: 02/20/2016
  5701) 
  5702)   implicit none
  5703)   
  5704)   !class(rpf_mod_BC_oil_type) :: this
  5705)   class(rpf_mod_BC_type) :: this
  5706) 
  5707)   call RPFBaseInit(this)
  5708)   this%m = UNINITIALIZED_DOUBLE
  5709)   this%Srg = UNINITIALIZED_DOUBLE
  5710)   this%Sro = UNINITIALIZED_DOUBLE
  5711)   this%kr_max = 1.0d0
  5712)    
  5713) !end subroutine RPF_Mod_BC_Oil_Init
  5714) end subroutine RPF_Mod_BC_Init
  5715) 
  5716) ! ************************************************************************** !
  5717) 
  5718) !subroutine RPF_Mod_BC_Oil_Verify(this,name,option)
  5719) subroutine RPF_Mod_BC_Verify(this,name,option)
  5720) 
  5721)   use Option_module
  5722) 
  5723)   implicit none
  5724)   
  5725)   !class(rpf_mod_BC_oil_type) :: this
  5726)   class(rpf_mod_BC_type) :: this
  5727)   character(len=MAXSTRINGLENGTH) :: name
  5728)   type(option_type) :: option
  5729)   
  5730)   character(len=MAXSTRINGLENGTH) :: string 
  5731) 
  5732)   if (index(name,'PERMEABILITY_FUNCTION') > 0) then
  5733)     string = name
  5734)   else
  5735)     select type(rpf => this)
  5736)       class is(rpf_mod_BC_liq_type) 
  5737)         string = trim(name) // 'PERMEABILITY_FUNCTION,MOD_BC_LIQ'
  5738)       class is(rpf_mod_BC_oil_type)
  5739)         string = trim(name) // 'PERMEABILITY_FUNCTION,MOD_BC_OIL'
  5740)     end select
  5741)   endif    
  5742)   call RPFBaseVerify(this,string,option)
  5743)   if (Uninitialized(this%Sro)) then
  5744)     option%io_buffer = UninitializedMessage('OIL_RESIDUAL_SATURATION',string)
  5745)     call printErrMsg(option)
  5746)   endif
  5747)   if (Uninitialized(this%Srg)) then
  5748)     option%io_buffer = UninitializedMessage('GAS_RESIDUAL_SATURATION',string)
  5749)     call printErrMsg(option)
  5750)   endif  
  5751) 
  5752)   if (Uninitialized(this%m)) then
  5753)     option%io_buffer = UninitializedMessage('POWER EXPONENT',string)
  5754)     call printErrMsg(option)
  5755)   endif
  5756)   
  5757) !end subroutine RPF_Mod_BC_Oil_Verify
  5758) end subroutine RPF_Mod_BC_Verify
  5759) 
  5760) 
  5761) ! ************************************************************************** !
  5762) 
  5763) subroutine RPF_Mod_BC_SetupPolynomials(this,option,error_string)
  5764) 
  5765)   ! Sets up polynomials for smoothing Modified BC permeability function
  5766) 
  5767)   use Option_module
  5768)   use Utility_module
  5769)   
  5770)   implicit none
  5771)   
  5772)   class(rpf_mod_BC_type) :: this
  5773)   type(option_type) :: option
  5774)   character(len=MAXSTRINGLENGTH) :: error_string
  5775)   
  5776)   PetscReal :: b(4)
  5777) 
  5778)   PetscReal :: Se_ph_low
  5779) 
  5780)   this%poly => PolynomialCreate()
  5781)   ! fill matix with values
  5782)   this%poly%low = 0.99d0  ! just below saturated
  5783)   !this%poly%low = 0.95d0  ! just below saturated 
  5784)   this%poly%high = 1.d0   ! saturated
  5785)   Se_ph_low = this%poly%low
  5786)   !select type(rpf => this)
  5787)   !  class is(rpf_mod_BC_liq_type) 
  5788)   !    Se_ph_low = ( this%poly%low - this%Sr ) / &
  5789)   !                (1.0 - this%Sro - this%Sr - this%Srg)
  5790)   !  class is(rpf_mod_BC_oil_type)
  5791)   !    Se_ph_low = ( this%poly%low - this%Sro ) / &
  5792)   !                (1.0 - this%Sro - this%Sr - this%Srg) 
  5793)   !end select 
  5794) 
  5795)   b(1) = this%kr_max
  5796)   b(2) = this%kr_max * (Se_ph_low ** this%m)
  5797)   b(3) = 0.d0
  5798)   b(4) = this%m * this%kr_max * Se_ph_low ** (this%m - 1.0 )
  5799)   
  5800)   call CubicPolynomialSetup(this%poly%high,this%poly%low,b)
  5801)   
  5802)   this%poly%coefficients(1:4) = b(1:4)
  5803)   
  5804) end subroutine RPF_Mod_BC_SetupPolynomials
  5805) 
  5806) ! ************************************************************************** !
  5807) 
  5808) subroutine RPF_Mod_BC_Liq_RelPerm(this,liquid_saturation, &
  5809)                                      relative_permeability,dkr_sat,option)
  5810)   ! 
  5811)   ! Computes the relative permeability (and associated derivatives) as a 
  5812)   ! function of saturation
  5813)   !
  5814)   ! Author: Paolo Orsini (OGS)
  5815)   ! Date: 02/21/2016
  5816) 
  5817)   use Option_module
  5818)   use Utility_module
  5819)   
  5820)   implicit none
  5821) 
  5822)   class(rpf_Mod_BC_liq_type) :: this
  5823)   PetscReal, intent(in) :: liquid_saturation
  5824)   PetscReal, intent(out) :: relative_permeability
  5825)   PetscReal, intent(out) :: dkr_sat
  5826)   type(option_type), intent(inout) :: option
  5827)   
  5828)   PetscReal :: Se
  5829)   PetscReal :: dkr_Se
  5830)   
  5831)   ! initialize to derivative to NaN so that not mistakenly used.
  5832)   dkr_sat = 0.d0
  5833)   dkr_sat = dkr_sat / 0.d0
  5834)   dkr_sat = dkr_sat * 0.d0
  5835) 
  5836)   Se = (liquid_saturation - this%Sr) / (1.d0 - this%Sro - this%Sr - this%Srg )
  5837) 
  5838)   if (Se >= 1.d0) then
  5839)     relative_permeability = this%kr_max
  5840)     return
  5841)   else if (Se <=  0.d0) then
  5842)     relative_permeability = 0.d0
  5843)     return
  5844)   endif
  5845) 
  5846)   if (associated(this%poly)) then
  5847)     if (Se > this%poly%low) then
  5848)       call CubicPolynomialEvaluate(this%poly%coefficients, &
  5849)                                    Se,relative_permeability,dkr_Se)
  5850)       return
  5851)     endif
  5852)   endif
  5853) 
  5854)   relative_permeability = this%kr_max * (Se ** this%m)
  5855) 
  5856) end subroutine RPF_Mod_BC_Liq_RelPerm
  5857) 
  5858) ! ************************************************************************** !
  5859) 
  5860) 
  5861) subroutine RPF_Mod_BC_Oil_RelPerm(this,liquid_saturation, &
  5862)                                      relative_permeability,dkr_sat,option)
  5863)   ! 
  5864)   ! Computes the relative permeability (and associated derivatives) as a 
  5865)   ! function of saturation
  5866)   !
  5867)   ! Author: Paolo Orsini (OGS)
  5868)   ! Date: 02/20/2016
  5869) 
  5870)   use Option_module
  5871)   use Utility_module
  5872)   
  5873)   implicit none
  5874) 
  5875)   class(rpf_Mod_BC_oil_type) :: this
  5876)   PetscReal, intent(in) :: liquid_saturation
  5877)   PetscReal, intent(out) :: relative_permeability
  5878)   PetscReal, intent(out) :: dkr_sat
  5879)   type(option_type), intent(inout) :: option
  5880)   
  5881)   PetscReal :: So
  5882)   PetscReal :: Se
  5883)   PetscReal :: Seo
  5884)   PetscReal :: dkr_Se
  5885)   
  5886)   ! initialize to derivative to NaN so that not mistakenly used.
  5887)   dkr_sat = 0.d0
  5888)   dkr_sat = dkr_sat / 0.d0
  5889)   dkr_sat = dkr_sat * 0.d0
  5890) 
  5891)   So = 1.d0 - liquid_saturation
  5892) 
  5893)   Seo = (So - this%Sro) / (1.d0 - this%Sro - this%Sr - this%Srg ) 
  5894) 
  5895)   if (Seo >= 1.d0) then
  5896)     relative_permeability = this%kr_max
  5897)     return
  5898)   else if (Seo <=  0.d0) then
  5899)     relative_permeability = 0.d0
  5900)     return
  5901)   endif
  5902) 
  5903)   if (associated(this%poly)) then
  5904)     if (Seo > this%poly%low) then
  5905)       call CubicPolynomialEvaluate(this%poly%coefficients, &
  5906)                                    Seo,relative_permeability,dkr_Se)
  5907)       return
  5908)     endif
  5909)   endif
  5910) 
  5911)   relative_permeability = this%kr_max * (Seo ** this%m)
  5912) 
  5913) end subroutine RPF_Mod_BC_Oil_RelPerm
  5914) 
  5915) !End RPF: Modified Brooks-Corey for the oil phase (RPF_Mod_BC_Oil)
  5916) 
  5917) ! ************************************************************************** !
  5918) 
  5919) function RPF_Constant_Create()
  5920) 
  5921)   ! Creates the constant relative permeability function object
  5922) 
  5923)   implicit none
  5924)   
  5925)   class(rel_perm_func_constant_type), pointer :: RPF_Constant_Create
  5926)   
  5927)   allocate(RPF_Constant_Create)
  5928)   call RPFBaseInit(RPF_Constant_Create)
  5929)   ! set Sr = 0. to avoid uninitialized failure
  5930)   RPF_Constant_Create%Sr = 0.d0
  5931)   RPF_Constant_Create%kr = 0.d0
  5932)   
  5933) end function RPF_Constant_Create
  5934) 
  5935) ! ************************************************************************** !
  5936) 
  5937) subroutine RPFConstantVerify(this,name,option)
  5938) 
  5939)   use Option_module
  5940)   
  5941)   implicit none
  5942)   
  5943)   class(rel_perm_func_constant_type) :: this  
  5944)   character(len=MAXSTRINGLENGTH) :: name
  5945)   type(option_type) :: option  
  5946) 
  5947)   character(len=MAXSTRINGLENGTH) :: string
  5948)   
  5949)   if (index(name,'PERMEABILITY_FUNCTION') > 0) then
  5950)     string = name
  5951)   else
  5952)     string = trim(name) // 'PERMEABILITY_FUNCTION,CONSTANT'
  5953)   endif  
  5954)   call RPFBaseVerify(this,string,option)
  5955)   if (Uninitialized(this%kr)) then
  5956)     option%io_buffer = UninitializedMessage('RELATIVE_PERMEABILITY',string)
  5957)     call printErrMsg(option)
  5958)   endif   
  5959) 
  5960) end subroutine RPFConstantVerify
  5961) 
  5962) ! ************************************************************************** !
  5963) 
  5964) subroutine RPF_ConstantRelPerm(this,liquid_saturation,relative_permeability, &
  5965)                             dkr_sat,option)
  5966)   use Option_module
  5967) 
  5968)   implicit none
  5969)   
  5970)   class(rel_perm_func_constant_type) :: this
  5971)   PetscReal, intent(in) :: liquid_saturation
  5972)   PetscReal, intent(out) :: relative_permeability
  5973)   PetscReal, intent(out) :: dkr_sat
  5974)   type(option_type), intent(inout) :: option
  5975)   
  5976)   relative_permeability = this%kr
  5977)   dkr_sat = 0.d0
  5978)   
  5979) end subroutine RPF_ConstantRelPerm
  5980) 
  5981) ! ************************************************************************** !
  5982) 
  5983) subroutine PolynomialDestroy(poly)
  5984)   ! 
  5985)   ! Destroys a polynomial smoother
  5986)   ! 
  5987)   ! Author: Glenn Hammond
  5988)   ! Date: 09/24/14
  5989)   ! 
  5990) 
  5991)   implicit none
  5992)   
  5993)   type(polynomial_type), pointer :: poly
  5994)   
  5995)   if (.not.associated(poly)) return
  5996)   
  5997)   deallocate(poly)
  5998)   nullify(poly)
  5999) 
  6000) end subroutine PolynomialDestroy
  6001) 
  6002) ! ************************************************************************** !
  6003) 
  6004) subroutine SaturationFunctionDestroy(sf)
  6005)   ! 
  6006)   ! Destroys a saturuation function
  6007)   ! 
  6008)   ! Author: Glenn Hammond
  6009)   ! Date: 09/24/14
  6010)   ! 
  6011) 
  6012)   implicit none
  6013)   
  6014)   class(sat_func_base_type), pointer :: sf
  6015)   
  6016)   if (.not.associated(sf)) return
  6017)   
  6018)   call PolynomialDestroy(sf%sat_poly)
  6019)   call PolynomialDestroy(sf%sat_poly)
  6020)   deallocate(sf)
  6021)   nullify(sf)
  6022) 
  6023) end subroutine SaturationFunctionDestroy
  6024) 
  6025) ! ************************************************************************** !
  6026) 
  6027) subroutine PermeabilityFunctionDestroy(rpf)
  6028)   ! 
  6029)   ! Destroys a saturuation function
  6030)   ! 
  6031)   ! Author: Glenn Hammond
  6032)   ! Date: 09/24/14
  6033)   ! 
  6034) 
  6035)   implicit none
  6036)   
  6037)   class(rel_perm_func_base_type), pointer :: rpf
  6038)   
  6039)   if (.not.associated(rpf)) return
  6040)   
  6041)   call PolynomialDestroy(rpf%poly)
  6042)   deallocate(rpf)
  6043)   nullify(rpf)
  6044) 
  6045) end subroutine PermeabilityFunctionDestroy
  6046) 
  6047) ! ************************************************************************** !
  6048) 
  6049) recursive subroutine CharacteristicCurvesDestroy(cc)
  6050)   ! 
  6051)   ! Destroys a characteristic curve
  6052)   ! 
  6053)   ! Author: Glenn Hammond
  6054)   ! Date: 09/24/14
  6055)   ! 
  6056) 
  6057)   implicit none
  6058)   
  6059)   class(characteristic_curves_type), pointer :: cc
  6060)   
  6061)   if (.not.associated(cc)) return
  6062)   
  6063)   call CharacteristicCurvesDestroy(cc%next)
  6064)   
  6065)   call SaturationFunctionDestroy(cc%saturation_function)
  6066) 
  6067)   ! the liquid and gas relative permeability pointers may pointer to the
  6068)   ! same address. if so, destroy one and nullify the other.
  6069)   if (associated(cc%liq_rel_perm_function,cc%gas_rel_perm_function)) then
  6070)     call PermeabilityFunctionDestroy(cc%liq_rel_perm_function)
  6071)     nullify(cc%gas_rel_perm_function)
  6072)   !PO how about avoiding xxx_rel_perm_function => aaa_rel_perm_function? 
  6073)   !   it should semplify code. It seems we do this only to pass verify 
  6074)   else if (associated(cc%oil_rel_perm_function,cc%gas_rel_perm_function)) then 
  6075)     call PermeabilityFunctionDestroy(cc%oil_rel_perm_function)
  6076)     nullify(cc%gas_rel_perm_function)
  6077)   else
  6078)     call PermeabilityFunctionDestroy(cc%liq_rel_perm_function)
  6079)     call PermeabilityFunctionDestroy(cc%gas_rel_perm_function)
  6080)     !call PermeabilityFunctionDestroy(cc%oil_rel_perm_function)
  6081)   endif
  6082) 
  6083)   deallocate(cc)
  6084)   nullify(cc)
  6085)   
  6086) end subroutine CharacteristicCurvesDestroy
  6087) 
  6088) ! ************************************************************************** !
  6089) 
  6090) end module Characteristic_Curves_module

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