pm_toil_ims.F90       coverage:  72.22 %func     44.19 %block


     1) module PM_TOilIms_class
     2) 
     3)   use PM_Base_class
     4)   use PM_Subsurface_Flow_class
     5)   
     6)   use PFLOTRAN_Constants_module
     7) 
     8)   implicit none
     9) 
    10)   private
    11) 
    12) #include "petsc/finclude/petscsys.h"
    13) 
    14) #include "petsc/finclude/petscvec.h"
    15) #include "petsc/finclude/petscvec.h90"
    16) #include "petsc/finclude/petscmat.h"
    17) #include "petsc/finclude/petscmat.h90"
    18) #include "petsc/finclude/petscsnes.h"
    19) 
    20)   type, public, extends(pm_subsurface_flow_type) :: pm_toil_ims_type
    21)     PetscReal :: dPmax
    22)     PetscReal :: dTmax
    23)     PetscReal :: dSmax
    24)     PetscReal :: dPmax_allowable
    25)     PetscReal :: dTmax_allowable
    26)     PetscReal :: dSmax_allowable
    27)     PetscInt, pointer :: max_change_ivar(:)
    28)     PetscInt, pointer :: max_change_isubvar(:)
    29)   contains
    30)     ! all the routines below needs to be replaced, uncomment as I develop them
    31)     procedure, public :: Read => PMTOilImsRead
    32)     !procedure, public :: SetupSolvers => PMGeneralSetupSolvers
    33)     procedure, public :: InitializeRun => PMTOilImsInitializeRun
    34)     procedure, public :: InitializeTimestep => PMTOilImsInitializeTimestep
    35)     procedure, public :: Residual => PMTOilImsResidual
    36)     procedure, public :: Jacobian => PMTOilImsJacobian
    37)     procedure, public :: UpdateTimestep => PMTOilImsUpdateTimestep
    38)     procedure, public :: PreSolve => PMTOilImsPreSolve
    39)     !procedure, public :: PostSolve => PMGeneralPostSolve
    40)     procedure, public :: CheckUpdatePre => PMTOilImsCheckUpdatePre
    41)     procedure, public :: CheckUpdatePost => PMTOilImsCheckUpdatePost
    42)     procedure, public :: TimeCut => PMTOilImsTimeCut
    43)     procedure, public :: UpdateSolution => PMTOilImsUpdateSolution
    44)     procedure, public :: UpdateAuxVars => PMTOilImsUpdateAuxVars
    45)     procedure, public :: MaxChange => PMTOilImsMaxChange
    46)     !procedure, public :: ComputeMassBalance => PMGeneralComputeMassBalance
    47)     procedure, public :: CheckpointBinary => PMTOilImsCheckpointBinary
    48)     procedure, public :: RestartBinary => PMTOilImsRestartBinary
    49)     procedure, public :: InputRecord => PMTOilImsInputRecord
    50)     procedure, public :: Destroy => PMTOilImsDestroy
    51)   end type pm_toil_ims_type
    52)   
    53)   public :: PMToilImsCreate
    54)   
    55) contains
    56) 
    57) ! ************************************************************************** !
    58) 
    59) function PMTOilImsCreate()
    60)   ! 
    61)   ! Creates TOilIms process models shell
    62)   ! 
    63)   ! Author: Paolo Orsini (OGS)
    64)   ! Date: 9/8/15
    65)   ! 
    66)   use Variables_module, only : LIQUID_PRESSURE, OIL_PRESSURE, OIL_SATURATION, &
    67)                                TEMPERATURE
    68)   implicit none
    69)   
    70)   class(pm_toil_ims_type), pointer :: PMToilImsCreate
    71) 
    72)   class(pm_toil_ims_type), pointer :: toil_ims_pm
    73)   
    74) !#ifdef PM_TOIL_IMS_DEBUG  
    75)   print *, 'PMTOilImsCreate()'
    76) !#endif  
    77) 
    78)   allocate(toil_ims_pm)
    79) 
    80)   toil_ims_pm%dPmax = 0.d0
    81)   toil_ims_pm%dTmax = 0.d0
    82)   toil_ims_pm%dSmax = 0.d0
    83)   toil_ims_pm%dPmax_allowable = 5.d5 !Pa
    84)   toil_ims_pm%dTmax_allowable = 5.d0
    85)   toil_ims_pm%dSmax_allowable = 1.d0
    86)   allocate(toil_ims_pm%max_change_ivar(4))
    87)   toil_ims_pm%max_change_ivar = [LIQUID_PRESSURE, OIL_PRESSURE, &
    88)                                 OIL_SATURATION, TEMPERATURE]
    89)   allocate(toil_ims_pm%max_change_isubvar(4))
    90)   toil_ims_pm%max_change_isubvar = [0,0,0,0]
    91)   
    92)   call PMSubsurfaceFlowCreate(toil_ims_pm)
    93)   toil_ims_pm%name = 'PMTOilIms'
    94) 
    95)   PMTOilImsCreate => toil_ims_pm
    96)   
    97) end function PMTOilImsCreate
    98) 
    99) ! ************************************************************************** !
   100) 
   101) subroutine PMTOilImsRead(this,input)
   102)   ! 
   103)   ! Reads input specific to pm_toil_Ims.
   104)   ! 
   105)   ! Author: Paolo Orsini (OGS)
   106)   ! Date: Date: 9/9/15
   107)   !
   108)   ! use TOilIms_module ! shouldn't need this... 
   109)   use TOilIms_Aux_module
   110)   use Input_Aux_module
   111)   use String_module
   112)   use Option_module
   113) 
   114)   implicit none
   115) 
   116)   class(pm_toil_ims_type) :: this  
   117)   type(input_type), pointer :: input
   118)   
   119)   character(len=MAXWORDLENGTH) :: keyword, word
   120)   
   121)   type(option_type), pointer :: option
   122)   PetscReal :: tempreal
   123)   character(len=MAXSTRINGLENGTH) :: error_string
   124) 
   125)   option => this%option
   126) 
   127)   error_string = 'TOilIms Options'  
   128) 
   129)   input%ierr = 0
   130)   do
   131)   
   132)     call InputReadPflotranString(input,option)
   133) 
   134)     if (InputCheckExit(input,option)) exit  
   135) 
   136)     call InputReadWord(input,option,keyword,PETSC_TRUE)
   137)     call InputErrorMsg(input,option,'keyword',error_string)
   138)     call StringToUpper(keyword)   
   139)       
   140)     select case(trim(keyword))
   141)       case('ITOL_SCALED_RESIDUAL')
   142)         call InputReadDouble(input,option,toil_ims_itol_scaled_res)
   143)         call InputDefaultMsg(input,option,'toil_ims_itol_scaled_res')
   144)         this%check_post_convergence = PETSC_TRUE
   145)       case('ITOL_RELATIVE_UPDATE')
   146)         call InputReadDouble(input,option,toil_ims_itol_rel_update)
   147)         call InputDefaultMsg(input,option,'toil_ims_itol_rel_update')
   148)         this%check_post_convergence = PETSC_TRUE        
   149)       case('TOUGH2_ITOL_SCALED_RESIDUAL')
   150)         call InputReadDouble(input,option,tempreal)
   151)         call InputDefaultMsg(input,option,'tough_itol_scaled_residual_e1')
   152)         toil_ims_tgh2_itol_scld_res_e1 = tempreal
   153)         call InputReadDouble(input,option,toil_ims_tgh2_itol_scld_res_e2)
   154)         call InputDefaultMsg(input,option,'tough_itol_scaled_residual_e2')
   155)         toil_ims_tough2_conv_criteria = PETSC_TRUE
   156)         this%check_post_convergence = PETSC_TRUE
   157)       case('WINDOW_EPSILON') 
   158)         call InputReadDouble(input,option,toil_ims_window_epsilon)
   159)         call InputErrorMsg(input,option,'window epsilon',error_string)
   160)       ! consider to move in this in eos_oil, since this is an eos property
   161)       !case('OIL_COMPONENT_FORMULA_WEIGHT')
   162)       !  !assuming oil component is index 2, H2O ois index 1
   163)       !  call InputReadDouble(input,option,toil_ims_fmw_comp(2))
   164)       !  call InputErrorMsg(input,option,'oil component formula wt.', &
   165)       !                     'TOIL_IMS_MODE')
   166)       case('ISOTHERMAL')
   167)         toil_ims_isothermal = PETSC_TRUE
   168)       case('MAXIMUM_PRESSURE_CHANGE')
   169)         call InputReadDouble(input,option,toil_ims_max_pressure_change)
   170)         call InputErrorMsg(input,option,'maximum pressure change', &
   171)                            error_string)
   172)       case('MAX_ITERATION_BEFORE_DAMPING')
   173)         call InputReadInt(input,option,toil_ims_max_it_before_damping)
   174)         call InputErrorMsg(input,option,'maximum iteration before damping', &
   175)                            error_string)
   176)       case('DAMPING_FACTOR')
   177)         call InputReadDouble(input,option,toil_ims_damping_factor)
   178)         call InputErrorMsg(input,option,'damping factor',error_string)
   179)       case('GOVERN_MAXIMUM_PRESSURE_CHANGE')
   180)         call InputReadDouble(input,option,this%dPmax_allowable)
   181)         call InputErrorMsg(input,option,'maximum allowable pressure change', &
   182)                            error_string)
   183)       case('GOVERN_MAXIMUM_TEMPERATURE_CHANGE')
   184)         call InputReadDouble(input,option,this%dTmax_allowable)
   185)         call InputErrorMsg(input,option, &
   186)                            'maximum allowable temperature change', &
   187)                            error_string)
   188)       case('GOVERN_MAXIMUM_SATURATION_CHANGE')
   189)         call InputReadDouble(input,option,this%dSmax_allowable)
   190)         call InputErrorMsg(input,option,'maximum allowable saturation change', &
   191)                            error_string)
   192)       case('DEBUG_CELL')
   193)         call InputReadInt(input,option,toil_ims_debug_cell_id)
   194)         call InputErrorMsg(input,option,'debug cell id',error_string)
   195)       ! might need some input here for the thermal diffusion model
   196)       !case('NO_TEMP_DEPENDENT_DIFFUSION')
   197)       !  general_temp_dep_gas_air_diff = PETSC_FALSE
   198)       !case('HARMONIC_GAS_DIFFUSIVE_DENSITY')
   199)       !  general_harmonic_diff_density = PETSC_TRUE
   200)       !case('ARITHMETIC_GAS_DIFFUSIVE_DENSITY')
   201)       !  general_harmonic_diff_density = PETSC_FALSE
   202)       case default
   203)         call InputKeywordUnrecognized(keyword,'TOIL_IMS Mode',option)
   204)     end select
   205)     
   206)   enddo  
   207)   
   208) end subroutine PMTOilImsRead
   209) 
   210) ! ************************************************************************** !
   211) 
   212) recursive subroutine PMTOilImsInitializeRun(this)
   213)   ! 
   214)   ! Initializes the time stepping
   215)   ! 
   216)   ! Author: Paolo Orsini (OGS)
   217)   ! Date: 10/23/15
   218) 
   219)   use Realization_Base_class
   220)   
   221)   implicit none
   222)   
   223)   class(pm_toil_ims_type) :: this
   224)   
   225)   PetscInt :: i
   226)   PetscErrorCode :: ierr
   227) 
   228)   ! need to allocate vectors for max change
   229)   call VecDuplicateVecsF90(this%realization%field%work,FOUR_INTEGER, &
   230)                            this%realization%field%max_change_vecs, &
   231)                            ierr);CHKERRQ(ierr)
   232)   ! set initial values
   233)   do i = 1, 4
   234)     call RealizationGetVariable(this%realization, &
   235)                                 this%realization%field%max_change_vecs(i), &
   236)                                 this%max_change_ivar(i), &
   237)                                 this%max_change_isubvar(i))
   238)   enddo
   239) 
   240) 
   241)   ! call parent implementation
   242)   call PMSubsurfaceFlowInitializeRun(this)
   243) 
   244) end subroutine PMTOilImsInitializeRun
   245) 
   246) ! ************************************************************************** !
   247) 
   248) subroutine PMTOilImsInitializeTimestep(this)
   249)   ! 
   250)   ! Should not need this as it is called in PreSolve.
   251)   ! 
   252)   ! Author: Glenn Hammond
   253)   ! Date: 03/14/13
   254)   ! 
   255) 
   256)   use TOilIms_module, only : TOilImsInitializeTimestep
   257)   use Global_module
   258)   use Variables_module, only : TORTUOSITY
   259)   use Material_module, only : MaterialAuxVarCommunicate
   260)   
   261)   implicit none
   262)   
   263)   class(pm_toil_ims_type) :: this
   264) 
   265)   call PMSubsurfaceFlowInitializeTimestepA(this)                                 
   266) !geh:remove   everywhere                                
   267)   call MaterialAuxVarCommunicate(this%comm1, &
   268)                                  this%realization%patch%aux%Material, &
   269)                                  this%realization%field%work_loc,TORTUOSITY, &
   270)                                  ZERO_INTEGER)
   271)                                  
   272)   if (this%option%print_screen_flag) then
   273)     write(*,'(/,2("=")," TOIL_IMS FLOW ",64("="))')
   274)   endif
   275)   
   276)   call TOilImsInitializeTimestep(this%realization)
   277) 
   278)   call PMSubsurfaceFlowInitializeTimestepB(this)                                 
   279)   
   280) end subroutine PMTOilImsInitializeTimestep
   281) 
   282) ! ************************************************************************** !
   283) 
   284) subroutine PMTOilImsPreSolve(this)
   285)   ! 
   286)   ! Author: Paolo Orsini (OGS)
   287)   ! Date: 10/23/15
   288) 
   289)   implicit none
   290) 
   291)   class(pm_toil_ims_type) :: this
   292) 
   293)   ! currently does nothing - could add here explicit iitialization
   294)   ! for highly het. problems
   295) 
   296) end subroutine PMTOilImsPreSolve
   297) 
   298) ! ************************************************************************** !
   299) 
   300) subroutine PMTOilImsUpdateAuxVars(this)
   301)   ! 
   302)   ! Author: Paolo Orsini (OGS)
   303)   ! Date: 10/23/15
   304) 
   305)   use TOilIms_module, only : TOilImsUpdateAuxVars
   306) 
   307)   implicit none
   308)   
   309)   class(pm_toil_ims_type) :: this
   310) 
   311)   call TOilImsUpdateAuxVars(this%realization)
   312) 
   313) end subroutine PMTOilImsUpdateAuxVars   
   314) 
   315) ! ************************************************************************** !
   316) 
   317) subroutine PMTOilImsUpdateSolution(this)
   318)   ! 
   319)   ! Author: Paolo Orsini (OGS)
   320)   ! Date: 10/23/15
   321)   ! 
   322) 
   323)   use TOilIms_module, only : TOilImsUpdateSolution, &
   324)                              TOilImsMapBCAuxVarsToGlobal 
   325) 
   326)   implicit none
   327)   
   328)   class(pm_toil_ims_type) :: this
   329)   
   330)   call PMSubsurfaceFlowUpdateSolution(this)
   331)   call TOilImsUpdateSolution(this%realization)
   332)   call TOilImsMapBCAuxVarsToGlobal(this%realization)
   333) 
   334) end subroutine PMTOilImsUpdateSolution     
   335) 
   336) 
   337) ! ************************************************************************** !
   338) 
   339) subroutine PMTOilImsUpdateTimestep(this,dt,dt_min,dt_max,iacceleration, &
   340)                                     num_newton_iterations,tfac)
   341)   ! 
   342)   ! Author: Paolo Orsini
   343)   ! Date: 11/09/15
   344)   ! 
   345) 
   346)   implicit none
   347)   
   348)   class(pm_toil_ims_type) :: this
   349)   PetscReal :: dt
   350)   PetscReal :: dt_min,dt_max
   351)   PetscInt :: iacceleration
   352)   PetscInt :: num_newton_iterations
   353)   PetscReal :: tfac(:)
   354)   
   355)   PetscReal :: fac
   356)   PetscInt :: ifac
   357)   PetscReal :: up, ut, us, umin
   358)   PetscReal :: dtt
   359)   
   360) !#ifdef PM_GENERAL_DEBUG  
   361) !  call printMsg(this%option,'PMGeneral%UpdateTimestep()')
   362) !#endif
   363)   
   364)   fac = 0.5d0
   365)   if (num_newton_iterations >= iacceleration) then
   366)     fac = 0.33d0
   367)     umin = 0.d0
   368)   else
   369)     up = this%dPmax_allowable/(this%dPmax+0.1)
   370)     ut = this%dTmax_allowable/(this%dTmax+1.d-5)
   371)     us = this%dSmax_allowable/(this%dSmax+1.d-5)
   372)     umin = min(up,ut,us)
   373)   endif
   374)   ifac = max(min(num_newton_iterations,size(tfac)),1)
   375)   dtt = fac * dt * (1.d0 + umin)
   376)   dt = min(dtt,tfac(ifac)*dt,dt_max)
   377)   dt = max(dt,dt_min)
   378) 
   379)   call PMSubsurfaceFlowLimitDTByCFL(this,dt)
   380) 
   381) end subroutine PMTOilImsUpdateTimestep
   382) 
   383) ! ************************************************************************** !
   384) 
   385) subroutine PMTOilImsResidual(this,snes,xx,r,ierr)
   386)   ! 
   387)   ! Author: Paolo Orsini
   388)   ! Date: 11/07/15
   389)   ! 
   390) 
   391)   use TOilIms_module, only : TOilImsResidual
   392) 
   393)   implicit none
   394)   
   395)   class(pm_toil_ims_type) :: this
   396)   SNES :: snes
   397)   Vec :: xx
   398)   Vec :: r
   399)   PetscErrorCode :: ierr
   400)   
   401)   ! in theroy call for material properties update - currently does nothing 
   402)   call PMSubsurfaceFlowUpdatePropertiesNI(this) 
   403)   call TOilImsResidual(snes,xx,r,this%realization,ierr)
   404) 
   405) end subroutine PMTOilImsResidual
   406) 
   407) ! ************************************************************************** !
   408) 
   409) subroutine PMTOilImsJacobian(this,snes,xx,A,B,ierr)
   410)   ! 
   411)   ! Author: Paolo Orsini
   412)   ! Date: 11/07/15
   413)   ! 
   414) 
   415)   use TOilIms_module, only : ToilImsJacobian
   416) 
   417)   implicit none
   418)   
   419)   class(pm_toil_ims_type) :: this
   420)   SNES :: snes
   421)   Vec :: xx
   422)   Mat :: A, B
   423)   PetscErrorCode :: ierr
   424)   
   425)   call TOilImsJacobian(snes,xx,A,B,this%realization,ierr)
   426) 
   427) end subroutine PMTOilImsJacobian
   428) 
   429) 
   430) ! ************************************************************************** !
   431) 
   432) !subroutine PMTOilImsCheckUpdatePre(this,line_search,P,dP,changed,ierr)
   433) !  ! 
   434) !  ! Author: Paolo Orsini (OGS)
   435) !  ! Date: 10/22/15
   436) !  ! 
   437) !
   438) !  use TOilIms_module, only : TOilImsCheckUpdatePre
   439) !
   440) !  implicit none
   441) !  
   442) !  class(pm_toil_ims_type) :: this
   443) !  SNESLineSearch :: line_search
   444) !  Vec :: P
   445) !  Vec :: dP
   446) !  PetscBool :: changed
   447) !  PetscErrorCode :: ierr
   448) !  
   449) !  call TOilImsCheckUpdatePre(line_search,P,dP,changed,this%realization,ierr)
   450) !
   451) !end subroutine PMTOilImsCheckUpdatePre
   452) 
   453) ! ************************************************************************** !
   454) ! use function below when switching to latest code
   455) subroutine PMTOilImsCheckUpdatePre(this,line_search,X,dX,changed,ierr)
   456)   ! 
   457)   ! Author: Paolo Orsini (OGS)
   458)   ! Date: 11/09/15
   459)   ! 
   460)   !use Realization_Subsurface_class
   461)   use Grid_module
   462)   use TOilIms_Aux_module
   463)   !use Global_Aux_module
   464)   use Field_module
   465)   use Option_module
   466)   use Patch_module
   467) 
   468)   implicit none
   469)   
   470)   class(pm_toil_ims_type) :: this
   471)   SNESLineSearch :: line_search
   472)   Vec :: X
   473)   Vec :: dX
   474)   PetscBool :: changed
   475)   PetscErrorCode :: ierr
   476)   
   477)   PetscReal, pointer :: X_p(:), dX_p(:)
   478) 
   479)   type(grid_type), pointer :: grid
   480)   type(option_type), pointer :: option
   481)   type(patch_type), pointer :: patch
   482)   type(field_type), pointer :: field
   483) 
   484)   !type(toil_ims_auxvar_type), pointer :: toil_auxvars(:,:)
   485)   !type(global_auxvar_type), pointer :: global_auxvars(:)  
   486) 
   487)   PetscInt :: local_id, ghosted_id
   488)   PetscInt :: offset
   489) 
   490)   PetscInt :: pressure_index, saturation_index, temperature_index
   491) 
   492)   PetscReal :: pressure0, pressure1, del_pressure
   493)   PetscReal :: temperature0, temperature1, del_temperature
   494)   PetscReal :: saturation0, saturation1, del_saturation
   495) 
   496)   PetscReal :: max_saturation_change = 0.125d0
   497)   PetscReal :: max_temperature_change = 10.d0
   498)   PetscReal :: scale, temp_scale, temp_real
   499)   PetscReal, parameter :: tolerance = 0.99d0
   500)   PetscReal, parameter :: initial_scale = 1.d0
   501)   SNES :: snes
   502)   PetscInt :: newton_iteration
   503) 
   504)   
   505)   grid => this%realization%patch%grid
   506)   option => this%realization%option
   507)   field => this%realization%field
   508)   !toil_auxvars => this%realization%patch%aux%TOil_ims%auxvars
   509)   !global_auxvars => this%realization%patch%aux%Global%auxvars
   510) 
   511)   patch => this%realization%patch
   512) 
   513)   call SNESLineSearchGetSNES(line_search,snes,ierr)
   514)   call SNESGetIterationNumber(snes,newton_iteration,ierr)
   515) 
   516)   call VecGetArrayF90(dX,dX_p,ierr);CHKERRQ(ierr)
   517)   call VecGetArrayReadF90(X,X_p,ierr);CHKERRQ(ierr)
   518) 
   519)   changed = PETSC_TRUE
   520) 
   521)   ! truncation
   522)   ! Oil Saturation must be truncated.  we do not use scaling
   523)   ! here because of the very small values.  just truncation.
   524)   do local_id = 1, grid%nlmax
   525)     ghosted_id = grid%nL2G(local_id)
   526)     if (patch%imat(ghosted_id) <= 0) cycle
   527)     offset = (local_id-1)*option%nflowdof
   528)     saturation_index = offset + TOIL_IMS_SATURATION_DOF
   529)     if ( (X_p(saturation_index) - dX_p(saturation_index)) < 0.d0 ) then
   530)       ! we use 1.d-6 since cancelation can occur with smaller values
   531)       ! this threshold is imposed in the initial condition
   532)       dX_p(saturation_index) = X_p(saturation_index)
   533)     end if
   534)   enddo
   535) 
   536)   scale = initial_scale
   537)   if (toil_ims_max_it_before_damping > 0 .and. &
   538)       newton_iteration > toil_ims_max_it_before_damping) then
   539)     scale = toil_ims_damping_factor
   540)   endif
   541) 
   542) #define LIMIT_MAX_PRESSURE_CHANGE
   543) #define LIMIT_MAX_SATURATION_CHANGE
   544) !!#define LIMIT_MAX_TEMPERATURE_CHANGE
   545) !! TRUNCATE_PRESSURE is needed for times when the solve wants
   546) !! to pull them negative.
   547) !#define TRUNCATE_PRESSURE
   548) 
   549)   ! scaling
   550)   do local_id = 1, grid%nlmax
   551)     ghosted_id = grid%nL2G(local_id)
   552)     offset = (local_id-1)*option%nflowdof
   553)     temp_scale = 1.d0
   554)     pressure_index = offset + TOIL_IMS_PRESSURE_DOF
   555)     saturation_index = offset + TOIL_IMS_SATURATION_DOF
   556)     temperature_index  = offset + TOIL_IMS_ENERGY_DOF
   557)     dX_p(pressure_index) = dX_p(pressure_index) * toil_ims_pressure_scale
   558)     temp_scale = 1.d0
   559)     del_pressure = dX_p(pressure_index)
   560)     pressure0 = X_p(pressure_index)
   561)     pressure1 = pressure0 - del_pressure
   562)     del_saturation = dX_p(saturation_index)
   563)     saturation0 = X_p(saturation_index)
   564)     saturation1 = saturation0 - del_saturation
   565) #ifdef LIMIT_MAX_PRESSURE_CHANGE
   566)     if (dabs(del_pressure) > toil_ims_max_pressure_change) then
   567)       temp_real = dabs(toil_ims_max_pressure_change/del_pressure)
   568)       temp_scale = min(temp_scale,temp_real)
   569)      endif
   570) #endif
   571) #ifdef TRUNCATE_PRESSURE
   572)     if (pressure1 <= 0.d0) then
   573)       if (dabs(del_pressure) > 1.d-40) then
   574)         temp_real = tolerance * dabs(pressure0 / del_pressure)
   575)         temp_scale = min(temp_scale,temp_real)
   576)       endif
   577)     endif
   578) #endif 
   579) !TRUNCATE_PRESSURE
   580) 
   581) #ifdef LIMIT_MAX_SATURATION_CHANGE
   582)     if (dabs(del_saturation) > max_saturation_change) then
   583)        temp_real = dabs(max_saturation_change/del_saturation)
   584)        temp_scale = min(temp_scale,temp_real)
   585)     endif
   586) #endif 
   587) !LIMIT_MAX_SATURATION_CHANGE        
   588)     scale = min(scale,temp_scale) 
   589)   enddo
   590) 
   591)   temp_scale = scale
   592)   call MPI_Allreduce(temp_scale,scale,ONE_INTEGER_MPI, &
   593)                      MPI_DOUBLE_PRECISION, &
   594)                      MPI_MIN,option%mycomm,ierr)
   595) 
   596)   ! it performs an homogenous scaling using the smallest scaling factor
   597)   ! over all subdomains domains
   598)   if (scale < 0.9999d0) then
   599)     dX_p = scale*dX_p
   600)   endif
   601) 
   602)   call VecRestoreArrayF90(dX,dX_p,ierr);CHKERRQ(ierr)
   603)   call VecRestoreArrayReadF90(X,X_p,ierr);CHKERRQ(ierr)
   604) 
   605) end subroutine PMTOilImsCheckUpdatePre
   606) 
   607) ! ************************************************************************** !
   608) 
   609) ! ************************************************************************** !
   610) 
   611) !subroutine PMTOilImsCheckUpdatePost(this,line_search,P0,dP,P1,dP_changed, &
   612) !                                    P1_changed,ierr)
   613) !  ! 
   614) !  ! Author: Paolo Orsini
   615) !  ! Date: 11/09/15
   616) !  ! 
   617) !
   618) !  use TOilIms_module, only : TOilImsCheckUpdatePost
   619) !
   620) !  implicit none
   621) !  
   622) !  class(pm_toil_ims_type) :: this
   623) !  SNESLineSearch :: line_search
   624) !  Vec :: P0
   625) !  Vec :: dP
   626) !  Vec :: P1
   627) !  PetscBool :: dP_changed
   628) !  PetscBool :: P1_changed
   629) !  PetscErrorCode :: ierr
   630) !  
   631) !  call TOilImsCheckUpdatePost(line_search,P0,dP,P1,dP_changed, &
   632) !                                   P1_changed,this%realization,ierr)
   633) !
   634) !end subroutine PMTOilImsCheckUpdatePost
   635) 
   636) ! ************************************************************************** !
   637) ! use function below when switching to the latest code
   638) subroutine PMTOilImsCheckUpdatePost(this,line_search,X0,dX,X1,dX_changed, &
   639)                                     X1_changed,ierr)
   640)   ! 
   641)   ! Author: Paolo Orsini
   642)   ! Date: 11/09/15
   643)   ! 
   644)   !use Global_Aux_module
   645)   use TOilIms_Aux_module
   646)   use Grid_module
   647)   use Option_module
   648)   !use Realization_Subsurface_class
   649)   use Grid_module
   650)   use Field_module
   651)   use Patch_module
   652)   use Option_module
   653)   use Material_Aux_class  
   654)   !use Output_EKG_module
   655)   
   656)   implicit none
   657)   
   658)   class(pm_toil_ims_type) :: this
   659)   SNESLineSearch :: line_search
   660)   Vec :: X0
   661)   Vec :: dX
   662)   Vec :: X1
   663)   PetscBool :: dX_changed
   664)   PetscBool :: X1_changed
   665)   PetscErrorCode :: ierr
   666) 
   667)   PetscReal, pointer :: X0_p(:)
   668)   PetscReal, pointer :: X1_p(:)
   669)   PetscReal, pointer :: dX_p(:)
   670)   PetscReal, pointer :: r_p(:)
   671)   PetscReal, pointer :: accum_p(:), accum_p2(:)
   672)   type(grid_type), pointer :: grid
   673)   type(option_type), pointer :: option
   674)   type(field_type), pointer :: field
   675)   type(patch_type), pointer :: patch
   676)   class(material_auxvar_type), pointer :: material_auxvars(:)  
   677)   PetscInt :: local_id, ghosted_id
   678)   PetscInt :: offset , ival, idof
   679)   PetscReal :: dX_X0, R_A, R
   680) 
   681)   PetscReal :: inf_norm_rel_update(3), global_inf_norm_rel_update(3)
   682)   PetscReal :: inf_norm_scaled_residual(3), global_inf_norm_scaled_residual(3)
   683)   PetscReal :: inf_norm_update(3), global_inf_norm_update(3)
   684)   PetscReal :: inf_norm_residual(3), global_inf_norm_residual(3)
   685)   PetscReal :: two_norm_residual(3), global_two_norm_residual(3)
   686)   PetscReal, parameter :: inf_pres_tol = 1.d-1
   687)   PetscReal, parameter :: inf_temp_tol = 1.d-5
   688)   PetscReal, parameter :: inf_sat_tol = 1.d-6
   689)   !geh: note the scaling by 0.d0 several lines down which prevent false 
   690)   !     convergence 
   691)   ! PO scaling by 0 kill the inf_norm_update convergence criteria
   692)   PetscReal, parameter :: inf_norm_update_tol(3) = &
   693)     reshape([inf_pres_tol,inf_sat_tol,inf_temp_tol], &
   694)             shape(inf_norm_update_tol)) * &
   695)             0.d0
   696)   PetscReal :: temp(12), global_temp(12)
   697)   PetscMPIInt :: mpi_int
   698)   PetscBool :: converged_abs_update
   699)   PetscBool :: converged_rel_update
   700)   PetscBool :: converged_scaled_residual
   701)   PetscReal :: t_over_v
   702)  
   703)   grid => this%realization%patch%grid 
   704)   option => this%realization%option
   705)   field => this%realization%field
   706)   patch => this%realization%patch ! in patch imat for active/inactive cells
   707)   material_auxvars => patch%aux%Material%auxvars 
   708)  
   709)   ! it indicates that neither dX of the updated solution are modified 
   710)   dX_changed = PETSC_FALSE
   711)   X1_changed = PETSC_FALSE
   712)   
   713)   option%converged = PETSC_FALSE
   714)   if (this%check_post_convergence) then
   715)     call VecGetArrayReadF90(dX,dX_p,ierr);CHKERRQ(ierr)
   716)     call VecGetArrayReadF90(X0,X0_p,ierr);CHKERRQ(ierr)
   717)     call VecGetArrayReadF90(field%flow_r,r_p,ierr);CHKERRQ(ierr)
   718)     call VecGetArrayReadF90(field%flow_accum,accum_p,ierr);CHKERRQ(ierr)
   719)     call VecGetArrayReadF90(field%flow_accum2,accum_p2,ierr);CHKERRQ(ierr)
   720) 
   721)     inf_norm_update(:) = -1.d20
   722)     inf_norm_rel_update(:) = -1.d20
   723)     inf_norm_scaled_residual(:) = -1.d20
   724)     inf_norm_residual(:) = -1.d20
   725)     two_norm_residual(:) = 0.d0
   726)     do local_id = 1, grid%nlmax
   727)       offset = (local_id-1)*option%nflowdof
   728)       ghosted_id = grid%nL2G(local_id)
   729)       if (patch%imat(ghosted_id) <= 0) cycle
   730)       do idof = 1, option%nflowdof
   731)         ival = offset+idof
   732)         R = r_p(ival)
   733)         inf_norm_residual(idof) = max(inf_norm_residual(idof),dabs(R))
   734)         if (toil_ims_tough2_conv_criteria) then
   735)           !geh: scale by t_over_v to match TOUGH2 residual units. see equation
   736)           !     B.5 of TOUGH2 user manual (LBNL-43134)
   737)           t_over_v = option%flow_dt/material_auxvars(ghosted_id)%volume
   738)           if (accum_p2(ival)*t_over_v < toil_ims_tgh2_itol_scld_res_e2) then
   739)             R_A = dabs(R*t_over_v)
   740)           else
   741)             R_A = dabs(R/accum_p2(ival))
   742)           endif
   743)         else
   744)           R_A = dabs(R/accum_p(ival))
   745)         endif
   746)         dX_X0 = dabs(dX_p(ival)/X0_p(ival))
   747)         inf_norm_update(idof) = max(inf_norm_update(idof),dabs(dX_p(ival)))
   748)         if (inf_norm_rel_update(idof) < dX_X0) then
   749)           inf_norm_rel_update(idof) = dX_X0
   750)         endif
   751)         if (inf_norm_scaled_residual(idof) < R_A) then
   752)           inf_norm_scaled_residual(idof) = R_A
   753)         endif
   754)       enddo
   755)     enddo
   756)     temp(1:3) = inf_norm_update(:)
   757)     temp(4:6) = inf_norm_rel_update(:)
   758)     temp(7:9) = inf_norm_scaled_residual(:)
   759)     temp(10:12) = inf_norm_residual(:)
   760)     mpi_int = 12
   761)     call MPI_Allreduce(temp,global_temp,mpi_int, &
   762)                        MPI_DOUBLE_PRECISION,MPI_MAX,option%mycomm,ierr)
   763)     global_inf_norm_update(:) = global_temp(1:3)
   764)     global_inf_norm_rel_update(:) = global_temp(4:6)
   765)     global_inf_norm_scaled_residual(:) = global_temp(7:9)
   766)     global_inf_norm_residual(:) = global_temp(10:12)
   767) 
   768)     converged_abs_update = PETSC_TRUE
   769)     converged_scaled_residual = PETSC_TRUE
   770)     do idof = 1, option%nflowdof
   771)       ! imposing inf_norm_update <= inf_norm_update_tol for convergence
   772)       if (global_inf_norm_update(idof) > inf_norm_update_tol(idof)) then
   773)         converged_abs_update = PETSC_FALSE
   774)       endif
   775)       if (toil_ims_tough2_conv_criteria) then
   776)         if (global_inf_norm_scaled_residual(idof) > &
   777)             toil_ims_tgh2_itol_scld_res_e1(idof)) then
   778)           converged_scaled_residual = PETSC_FALSE
   779)         endif
   780)       endif
   781)     enddo  
   782) 
   783)     if (.not.toil_ims_tough2_conv_criteria) then
   784)       converged_scaled_residual = maxval(global_inf_norm_scaled_residual) < &
   785)                                   toil_ims_itol_scaled_res
   786)     endif
   787) 
   788)     ! global_inf_norm_rel_update alway >0 because dabs values 
   789)     ! when not inu, toil_ims_itol_rel_update < 0  because assigned uninitialized value (-999)
   790)     converged_rel_update = maxval(global_inf_norm_rel_update) < &
   791)                                   toil_ims_itol_rel_update  
   792) 
   793)    ! converged_rel_update = maxval(global_inf_norm_rel_update) < &
   794)    !                        option%flow%inf_rel_update_tol
   795)    ! if (toil_ims_tough2_conv_criteria) then
   796)    !   converged_scaled_residual = maxval(global_inf_norm_scaled_residual) < &
   797)    !                               toil_ims_tgh2_itol_scld_res_e1
   798)    ! else
   799)    !   converged_scaled_residual = maxval(global_inf_norm_scaled_residual) < &
   800)    !                               option%flow%inf_scaled_res_tol
   801)    ! endif
   802) #if 0
   803)     do idof = 1, option%nflowdof
   804)       if (global_inf_norm(idof) > option%flow%post_convergence_tol) then
   805)         converged_rel_update = PETSC_FALSE
   806)       endif
   807)     enddo
   808) #endif
   809)     option%converged = PETSC_FALSE
   810)     if (converged_abs_update .or. converged_rel_update .or. &
   811)         converged_scaled_residual) then
   812)       option%converged = PETSC_TRUE
   813)     endif
   814)     call VecRestoreArrayReadF90(dX,dX_p,ierr);CHKERRQ(ierr)
   815)     call VecRestoreArrayReadF90(X0,X0_p,ierr);CHKERRQ(ierr)
   816)     call VecRestoreArrayReadF90(field%flow_r,r_p,ierr);CHKERRQ(ierr)
   817)     call VecRestoreArrayReadF90(field%flow_accum,accum_p,ierr);CHKERRQ(ierr)
   818)     call VecRestoreArrayReadF90(field%flow_accum2,accum_p2,ierr);CHKERRQ(ierr)
   819) 
   820)   endif
   821) 
   822) end subroutine PMTOilImsCheckUpdatePost
   823) 
   824) ! ************************************************************************** !
   825) 
   826) subroutine PMTOilImsTimeCut(this)
   827)   ! 
   828)   ! Author: Glenn Hammond
   829)   ! Date: 03/14/13
   830)   ! 
   831) 
   832)   use TOilIms_module, only : TOilImsTimeCut
   833) 
   834)   implicit none
   835)   
   836)   class(pm_toil_ims_type) :: this
   837)   
   838)   call PMSubsurfaceFlowTimeCut(this)
   839)   call TOilImsTimeCut(this%realization)
   840) 
   841) end subroutine PMTOilImsTimeCut
   842) 
   843) ! ************************************************************************** !
   844) 
   845) ! ************************************************************************** !
   846) 
   847) subroutine PMTOilImsMaxChange(this)
   848)   ! 
   849)   ! Not needed given GeneralMaxChange is called in PostSolve
   850)   ! 
   851)   ! Author: Paolo Orsini
   852)   ! Date: 11/09/15
   853)   ! 
   854) 
   855)   use Realization_Base_class
   856)   use Realization_Subsurface_class
   857)   use Option_module
   858)   use Field_module
   859)   use Grid_module
   860)   use Global_Aux_module
   861)   !use General_Aux_module
   862)   use Variables_module, only : LIQUID_PRESSURE, OIL_PRESSURE, OIL_SATURATION, &
   863)                                TEMPERATURE
   864)   implicit none
   865)   
   866)   class(pm_toil_ims_type) :: this
   867)   
   868)   class(realization_subsurface_type), pointer :: realization
   869)   type(option_type), pointer :: option
   870)   type(field_type), pointer :: field
   871)   type(grid_type), pointer :: grid
   872)   PetscReal, pointer :: vec_ptr(:), vec_ptr2(:)
   873)   PetscReal :: max_change_local(4)
   874)   PetscReal :: max_change_global(4)
   875)   PetscReal :: max_change
   876)   PetscInt :: i, j
   877)   PetscInt :: local_id, ghosted_id
   878) 
   879)   PetscErrorCode :: ierr
   880)   
   881)   realization => this%realization
   882)   option => realization%option
   883)   field => realization%field
   884)   grid => realization%patch%grid
   885) 
   886)   ! max changes loaded in this%max_change_ivar(i) with the following order:
   887)   ! 1. LIQUID_PRESSURE, 2. OIL_PRESSURE, 3.OIL_SATURATION, 4.TEMPERATURE
   888) 
   889)   max_change_global = 0.d0
   890)   max_change_local = 0.d0
   891)   do i = 1,4
   892)     call RealizationGetVariable(realization,field%work, &
   893)                                 this%max_change_ivar(i), &
   894)                                 this%max_change_isubvar(i))
   895)     ! yes, we could use VecWAXPY and a norm here, but we need the ability
   896)     ! to customize
   897)     call VecGetArrayF90(field%work,vec_ptr,ierr);CHKERRQ(ierr)
   898)     call VecGetArrayF90(field%max_change_vecs(i),vec_ptr2,ierr);CHKERRQ(ierr)
   899)     max_change = 0.d0
   900)     do j = 1, grid%nlmax
   901)       ! have to weed out cells that changed state
   902)       if (dabs(vec_ptr(j)) > 1.d-40 .and. dabs(vec_ptr2(j)) > 1.d-40) then
   903)         max_change = max(max_change,dabs(vec_ptr(j)-vec_ptr2(j)))
   904)       endif
   905)     enddo
   906)     max_change_local(i) = max_change
   907)     call VecRestoreArrayF90(field%work,vec_ptr,ierr);CHKERRQ(ierr)
   908)     call VecRestoreArrayF90(field%max_change_vecs(i),vec_ptr2, &
   909)                             ierr);CHKERRQ(ierr)
   910)     call VecCopy(field%work,field%max_change_vecs(i),ierr);CHKERRQ(ierr)
   911)   enddo
   912)   call MPI_Allreduce(max_change_local,max_change_global,FOUR_INTEGER, &
   913)                       MPI_DOUBLE_PRECISION,MPI_MAX,option%mycomm,ierr)
   914)   ! print them out
   915)   if (OptionPrintToScreen(option)) then
   916)     write(*,'("  --> max chng: dpl= ",1pe12.4, " dpo= ",1pe12.4,&
   917)       & "  dso= ",1pe12.4,&
   918)       & " dt= ",1pe12.4)') &
   919)       max_change_global(1:4)
   920)   endif
   921)   if (OptionPrintToFile(option)) then
   922)     write(option%fid_out,'("  --> max chng: dpl= ",1pe12.4, " dpo= ",1pe12.4,&
   923)       & "  dso= ",1pe12.4, &
   924)       & " dt= ",1pe12.4)') &
   925)       max_change_global(1:4)
   926)   endif
   927)   this%dPmax = maxval(max_change_global(1:2))
   928)   this%dSmax = max_change_global(3)
   929)   this%dTmax = max_change_global(4)
   930)   
   931) end subroutine PMTOilImsMaxChange
   932) 
   933) ! ************************************************************************** !
   934) 
   935) subroutine PMTOilImsCheckpointBinary(this,viewer)
   936)   ! 
   937)   ! Checkpoints data associated with General PM
   938)   ! 
   939)   ! Author: Paolo Orsini
   940)   ! Date: 11/09/15
   941) 
   942)   use Checkpoint_module
   943)   use Global_module
   944)   use Variables_module, only : STATE
   945) 
   946)   implicit none
   947) #include "petsc/finclude/petscviewer.h"      
   948) 
   949)   class(pm_toil_ims_type) :: this
   950)   PetscViewer :: viewer
   951)  
   952)   ! currently doing this but it is not needed 
   953)   call GlobalGetAuxVarVecLoc(this%realization, &
   954)                              this%realization%field%iphas_loc, &
   955)                              STATE,ZERO_INTEGER)
   956)   call PMSubsurfaceFlowCheckpointBinary(this,viewer)
   957)   
   958) end subroutine PMTOilImsCheckpointBinary
   959) 
   960) ! ************************************************************************** !
   961) 
   962) subroutine PMTOilImsRestartBinary(this,viewer)
   963)   ! 
   964)   ! Restarts data associated with General PM
   965)   ! 
   966)   ! Author: Paolo Orsini
   967)   ! Date: 11/09/15
   968) 
   969)   use Checkpoint_module
   970)   use Global_module
   971)   use Variables_module, only : STATE
   972) 
   973)   implicit none
   974) #include "petsc/finclude/petscviewer.h"      
   975) 
   976)   class(pm_toil_ims_type) :: this
   977)   PetscViewer :: viewer
   978)   
   979)   call PMSubsurfaceFlowRestartBinary(this,viewer)
   980)   ! currently doing this but it is not needed for TOIL_IMS
   981)   call GlobalSetAuxVarVecLoc(this%realization, &
   982)                              this%realization%field%iphas_loc, &
   983)                              STATE,ZERO_INTEGER)
   984)   
   985) end subroutine PMTOilImsRestartBinary
   986) 
   987) ! ************************************************************************** !
   988) 
   989) subroutine PMTOilImsInputRecord(this)
   990)   ! 
   991)   ! Writes ingested information to the input record file.
   992)   ! 
   993)   ! Author: Jenn Frederick, SNL
   994)   ! Date: 03/21/2016
   995)   ! 
   996)   
   997)   implicit none
   998)   
   999)   class(pm_toil_ims_type) :: this
  1000) 
  1001)   character(len=MAXWORDLENGTH) :: word
  1002)   PetscInt :: id
  1003) 
  1004)   id = INPUT_RECORD_UNIT
  1005) 
  1006)   write(id,'(a29)',advance='no') 'pm: '
  1007)   write(id,'(a)') this%name
  1008)   write(id,'(a29)',advance='no') 'mode: '
  1009)   write(id,'(a)') 'thermal oil immiscible'
  1010) 
  1011) end subroutine PMTOilImsInputRecord
  1012) 
  1013) ! ************************************************************************** !
  1014) 
  1015) subroutine PMTOilImsDestroy(this)
  1016)   ! 
  1017)   ! Destroys General process model
  1018)   ! 
  1019)   ! Author: Paolo Orsini
  1020)   ! Date: 11/09/15
  1021)   ! 
  1022) 
  1023)   use TOilIms_module, only : TOilImsDestroy
  1024) 
  1025)   implicit none
  1026)   
  1027)   class(pm_toil_ims_type) :: this
  1028)   
  1029)   if (associated(this%next)) then
  1030)     call this%next%Destroy()
  1031)   endif
  1032) 
  1033)   deallocate(this%max_change_ivar)
  1034)   nullify(this%max_change_ivar)
  1035)   deallocate(this%max_change_isubvar)
  1036)   nullify(this%max_change_isubvar)
  1037) 
  1038)   ! preserve this ordering
  1039)   call TOilImsDestroy(this%realization)
  1040)   call PMSubsurfaceFlowDestroy(this)
  1041)   
  1042) end subroutine PMTOilImsDestroy
  1043) 
  1044) ! ************************************************************************** !
  1045) 
  1046) end module PM_TOilIms_class

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