pm_richards.F90       coverage:  76.47 %func     43.53 %block


     1) module PM_Richards_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_richards_type
    21)   contains
    22)     procedure, public :: Read => PMRichardsRead
    23)     procedure, public :: InitializeTimestep => PMRichardsInitializeTimestep
    24)     procedure, public :: Residual => PMRichardsResidual
    25)     procedure, public :: Jacobian => PMRichardsJacobian
    26)     procedure, public :: UpdateTimestep => PMRichardsUpdateTimestep
    27)     procedure, public :: PreSolve => PMRichardsPreSolve
    28)     procedure, public :: PostSolve => PMRichardsPostSolve
    29)     procedure, public :: CheckUpdatePre => PMRichardsCheckUpdatePre
    30)     procedure, public :: CheckUpdatePost => PMRichardsCheckUpdatePost
    31)     procedure, public :: TimeCut => PMRichardsTimeCut
    32)     procedure, public :: UpdateSolution => PMRichardsUpdateSolution
    33)     procedure, public :: UpdateAuxVars => PMRichardsUpdateAuxVars
    34)     procedure, public :: MaxChange => PMRichardsMaxChange
    35)     procedure, public :: ComputeMassBalance => PMRichardsComputeMassBalance
    36)     procedure, public :: InputRecord => PMRichardsInputRecord
    37)     procedure, public :: Destroy => PMRichardsDestroy
    38)   end type pm_richards_type
    39)   
    40)   public :: PMRichardsCreate
    41)   
    42) contains
    43) 
    44) ! ************************************************************************** !
    45) 
    46) function PMRichardsCreate()
    47)   ! 
    48)   ! Creates Richards process models shell
    49)   ! 
    50)   ! Author: Glenn Hammond
    51)   ! Date: 03/14/13
    52)   ! 
    53) 
    54)   implicit none
    55)   
    56)   class(pm_richards_type), pointer :: PMRichardsCreate
    57) 
    58)   class(pm_richards_type), pointer :: richards_pm
    59)   
    60)   allocate(richards_pm)
    61)   call PMSubsurfaceFlowCreate(richards_pm)
    62)   richards_pm%name = 'PMRichards'
    63) 
    64)   PMRichardsCreate => richards_pm
    65)   
    66) end function PMRichardsCreate
    67) 
    68) ! ************************************************************************** !
    69) 
    70) subroutine PMRichardsRead(this,input)
    71)   ! 
    72)   ! Reads input file parameters associated with the Richards process model
    73)   ! 
    74)   ! Author: Glenn Hammond
    75)   ! Date: 01/29/15
    76)   use Input_Aux_module
    77)   use String_module
    78)   use Utility_module
    79)   use EOS_Water_module  
    80)   use Option_module
    81)   use Richards_Aux_module
    82)  
    83)   implicit none
    84)   
    85)   class(pm_richards_type) :: this
    86)   type(input_type), pointer :: input
    87)   
    88)   character(len=MAXWORDLENGTH) :: word
    89)   character(len=MAXSTRINGLENGTH) :: error_string
    90)   type(option_type), pointer :: option
    91)   PetscBool :: found
    92) 
    93)   option => this%option
    94)   
    95)   error_string = 'Richards Options'
    96)   
    97)   input%ierr = 0
    98)   do
    99)   
   100)     call InputReadPflotranString(input,option)
   101)     if (InputError(input)) exit
   102)     if (InputCheckExit(input,option)) exit
   103)     
   104)     call InputReadWord(input,option,word,PETSC_TRUE)
   105)     call InputErrorMsg(input,option,'keyword',error_string)
   106)     call StringToUpper(word)
   107) 
   108)     found = PETSC_FALSE
   109)     call PMSubsurfaceFlowReadSelectCase(this,input,word,found,option)
   110)     if (found) cycle
   111)     
   112)     select case(trim(word))
   113)       case('ITOL_SCALED_RESIDUAL')
   114)         call InputReadDouble(input,option,richards_itol_scaled_res)
   115)         call InputDefaultMsg(input,option,'itol_scaled_residual')
   116)         this%check_post_convergence = PETSC_TRUE
   117)       case('ITOL_RELATIVE_UPDATE')
   118)         call InputReadDouble(input,option,richards_itol_rel_update)
   119)         call InputDefaultMsg(input,option,'richards_itol_rel_update')
   120)         this%check_post_convergence = PETSC_TRUE
   121)       case default
   122)         call InputKeywordUnrecognized(word,error_string,option)
   123)     end select
   124)   enddo
   125)   
   126) end subroutine PMRichardsRead
   127) 
   128) ! ************************************************************************** !
   129) 
   130) subroutine PMRichardsInitializeTimestep(this)
   131)   ! 
   132)   ! Should not need this as it is called in PreSolve.
   133)   ! 
   134)   ! Author: Glenn Hammond
   135)   ! Date: 03/14/13
   136)   ! 
   137) 
   138)   use Richards_module, only : RichardsInitializeTimestep
   139)   
   140)   implicit none
   141)   
   142)   class(pm_richards_type) :: this
   143) 
   144)   call PMSubsurfaceFlowInitializeTimestepA(this)
   145) 
   146)   if (this%option%print_screen_flag) then
   147)     write(*,'(/,2("=")," RICHARDS FLOW ",63("="))')
   148)   endif
   149)   
   150)   call RichardsInitializeTimestep(this%realization)
   151)   call PMSubsurfaceFlowInitializeTimestepB(this)
   152)   
   153) end subroutine PMRichardsInitializeTimestep
   154) 
   155) ! ************************************************************************** !
   156) 
   157) subroutine PMRichardsPreSolve(this)
   158)   ! 
   159)   ! Author: Glenn Hammond
   160)   ! Date: 03/14/13
   161) 
   162)   implicit none
   163)   
   164)   class(pm_richards_type) :: this
   165) 
   166) end subroutine PMRichardsPreSolve
   167) 
   168) ! ************************************************************************** !
   169) 
   170) subroutine PMRichardsPostSolve(this)
   171)   ! 
   172)   ! Author: Glenn Hammond
   173)   ! Date: 03/14/13
   174) 
   175)   implicit none
   176)   
   177)   class(pm_richards_type) :: this
   178)   
   179) end subroutine PMRichardsPostSolve
   180) 
   181) ! ************************************************************************** !
   182) 
   183) subroutine PMRichardsUpdateTimestep(this,dt,dt_min,dt_max,iacceleration, &
   184)                                     num_newton_iterations,tfac)
   185)   ! 
   186)   ! Author: Glenn Hammond
   187)   ! Date: 03/14/13
   188)   ! 
   189) 
   190)   implicit none
   191)   
   192)   class(pm_richards_type) :: this
   193)   PetscReal :: dt
   194)   PetscReal :: dt_min,dt_max
   195)   PetscInt :: iacceleration
   196)   PetscInt :: num_newton_iterations
   197)   PetscReal :: tfac(:)
   198)   
   199)   PetscReal :: fac
   200)   PetscReal :: ut
   201)   PetscReal :: up
   202)   PetscReal :: dtt
   203)   PetscReal :: dt_p
   204)   PetscReal :: dt_tfac
   205)   PetscInt :: ifac
   206)   
   207)   if (iacceleration > 0) then
   208)     fac = 0.5d0
   209)     if (num_newton_iterations >= iacceleration) then
   210)       fac = 0.33d0
   211)       ut = 0.d0
   212)     else
   213)       up = this%pressure_change_governor/(this%max_pressure_change+0.1)
   214)       ut = up
   215)     endif
   216)     dtt = fac * dt * (1.d0 + ut)
   217)   else
   218)     ifac = max(min(num_newton_iterations,size(tfac)),1)
   219)     dt_tfac = tfac(ifac) * dt
   220) 
   221)     fac = 0.5d0
   222)     up = this%pressure_change_governor/(this%max_pressure_change+0.1)
   223)     dt_p = fac * dt * (1.d0 + up)
   224) 
   225)     dtt = min(dt_tfac,dt_p)
   226)   endif
   227)   
   228)   if (dtt > 2.d0 * dt) dtt = 2.d0 * dt
   229)   if (dtt > dt_max) dtt = dt_max
   230)   ! geh: There used to be code here that cut the time step if it is too
   231)   !      large relative to the simulation time.  This has been removed.
   232)   dtt = max(dtt,dt_min)
   233)   dt = dtt
   234) 
   235)   call PMSubsurfaceFlowLimitDTByCFL(this,dt)
   236)   
   237) end subroutine PMRichardsUpdateTimestep
   238) 
   239) ! ************************************************************************** !
   240) 
   241) subroutine PMRichardsResidual(this,snes,xx,r,ierr)
   242)   ! 
   243)   ! Author: Glenn Hammond
   244)   ! Date: 03/14/13
   245)   ! 
   246) 
   247)   use Richards_module, only : RichardsResidual
   248) 
   249)   implicit none
   250)   
   251)   class(pm_richards_type) :: this
   252)   SNES :: snes
   253)   Vec :: xx
   254)   Vec :: r
   255)   PetscErrorCode :: ierr
   256)   
   257)   call PMSubsurfaceFlowUpdatePropertiesNI(this)
   258)   call RichardsResidual(snes,xx,r,this%realization,ierr)
   259) 
   260) end subroutine PMRichardsResidual
   261) 
   262) ! ************************************************************************** !
   263) 
   264) subroutine PMRichardsJacobian(this,snes,xx,A,B,ierr)
   265)   ! 
   266)   ! Author: Glenn Hammond
   267)   ! Date: 03/14/13
   268)   ! 
   269) 
   270)   use Richards_module, only : RichardsJacobian
   271) 
   272)   implicit none
   273)   
   274)   class(pm_richards_type) :: this
   275)   SNES :: snes
   276)   Vec :: xx
   277)   Mat :: A, B
   278)   PetscErrorCode :: ierr
   279)   
   280)   call RichardsJacobian(snes,xx,A,B,this%realization,ierr)
   281) 
   282) end subroutine PMRichardsJacobian
   283) 
   284) ! ************************************************************************** !
   285) 
   286) subroutine PMRichardsCheckUpdatePre(this,line_search,X,dX,changed,ierr)
   287)   ! 
   288)   ! Author: Glenn Hammond
   289)   ! Date: 03/14/13
   290)   ! 
   291) 
   292)   use Realization_Subsurface_class
   293)   use Grid_module
   294)   use Field_module
   295)   use Option_module
   296)   use Characteristic_Curves_module
   297)   use Patch_module
   298)   use Richards_Aux_module
   299)   use Global_Aux_module
   300)   use Patch_module
   301)   
   302)   implicit none
   303)   
   304)   class(pm_richards_type) :: this
   305)   SNESLineSearch :: line_search
   306)   Vec :: X
   307)   Vec :: dX
   308)   PetscBool :: changed
   309)   PetscErrorCode :: ierr
   310)   
   311)   PetscReal, pointer :: X_p(:)
   312)   PetscReal, pointer :: dX_p(:)
   313)   PetscReal, pointer :: r_p(:)
   314)   type(grid_type), pointer :: grid
   315)   type(option_type), pointer :: option
   316)   type(patch_type), pointer :: patch
   317)   type(field_type), pointer :: field
   318)   type(richards_auxvar_type), pointer :: rich_auxvars(:)
   319)   type(global_auxvar_type), pointer :: global_auxvars(:)  
   320)   PetscInt :: local_id, ghosted_id
   321)   PetscReal :: P_R, P0, P1, delP
   322)   PetscReal :: scale, sat, sat_pert, pert, pc_pert, press_pert, delP_pert
   323)   
   324)   patch => this%realization%patch
   325)   grid => patch%grid
   326)   option => this%realization%option
   327)   field => this%realization%field
   328)   rich_auxvars => patch%aux%Richards%auxvars
   329)   global_auxvars => patch%aux%Global%auxvars
   330) 
   331)   if (Initialized(this%saturation_change_limit)) then
   332) 
   333)     changed = PETSC_TRUE
   334) 
   335)     call VecGetArrayF90(dX,dX_p,ierr);CHKERRQ(ierr)
   336)     call VecGetArrayF90(X,X_p,ierr);CHKERRQ(ierr)
   337) 
   338)     pert = dabs(this%saturation_change_limit)
   339)     do local_id = 1, grid%nlmax
   340)       ghosted_id = grid%nL2G(local_id)
   341)       sat = global_auxvars(ghosted_id)%sat(1)
   342)       sat_pert = sat - sign(1.d0,sat-0.5d0)*pert
   343)       call patch%characteristic_curves_array( &
   344)              patch%sat_func_id(ghosted_id))%ptr% &
   345)              saturation_function%CapillaryPressure(sat_pert,pc_pert,option)
   346)       press_pert = option%reference_pressure - pc_pert
   347)       P0 = X_p(local_id)
   348)       delP = dX_p(local_id)
   349)       delP_pert = dabs(P0 - press_pert)
   350)       if (delP_pert < dabs(delP)) then
   351)         write(option%io_buffer,'("dP_trunc:",1i7,2es15.7)') &
   352)           grid%nG2A(grid%nL2G(local_id)),delP_pert,dabs(delP)
   353)         call printMsgAnyRank(option)
   354)       endif
   355)       delP = sign(min(dabs(delP),delP_pert),delP)
   356)       dX_p(local_id) = delP
   357)     enddo
   358)     
   359)     call VecRestoreArrayF90(dX,dX_p,ierr);CHKERRQ(ierr)
   360)     call VecRestoreArrayF90(X,X_p,ierr);CHKERRQ(ierr)
   361) 
   362)   endif
   363) 
   364)   if (Initialized(this%pressure_dampening_factor)) then
   365)     changed = PETSC_TRUE
   366)     ! P^p+1 = P^p - dP^p
   367)     P_R = option%reference_pressure
   368)     scale = this%pressure_dampening_factor
   369) 
   370)     call VecGetArrayF90(dX,dX_p,ierr);CHKERRQ(ierr)
   371)     call VecGetArrayF90(X,X_p,ierr);CHKERRQ(ierr)
   372)     call VecGetArrayF90(field%flow_r,r_p,ierr);CHKERRQ(ierr)
   373)     do local_id = 1, grid%nlmax
   374)       delP = dX_p(local_id)
   375)       P0 = X_p(local_id)
   376)       P1 = P0 - delP
   377)       if (P0 < P_R .and. P1 > P_R) then
   378)         write(option%io_buffer,'("U -> S:",1i7,2f12.1)') &
   379)           grid%nG2A(grid%nL2G(local_id)),P0,P1 
   380)         call printMsgAnyRank(option)
   381) #if 0
   382)         ghosted_id = grid%nL2G(local_id)
   383)         call RichardsPrintAuxVars(rich_auxvars(ghosted_id), &
   384)                                   global_auxvars(ghosted_id),ghosted_id)
   385)         write(option%io_buffer,'("Residual:",es15.7)') r_p(local_id)
   386)         call printMsgAnyRank(option)
   387) #endif
   388)       else if (P1 < P_R .and. P0 > P_R) then
   389)         write(option%io_buffer,'("S -> U:",1i7,2f12.1)') &
   390)           grid%nG2A(grid%nL2G(local_id)),P0,P1
   391)         call printMsgAnyRank(option)
   392) #if 0
   393)         ghosted_id = grid%nL2G(local_id)
   394)         call RichardsPrintAuxVars(rich_auxvars(ghosted_id), &
   395)                                   global_auxvars(ghosted_id),ghosted_id)
   396)         write(option%io_buffer,'("Residual:",es15.7)') r_p(local_id)
   397)         call printMsgAnyRank(option)
   398) #endif
   399)       endif
   400)       ! transition from unsaturated to saturated
   401)       if (P0 < P_R .and. P1 > P_R) then
   402)         dX_p(local_id) = scale*delP
   403)       endif
   404)     enddo
   405)     call VecRestoreArrayF90(dX,dX_p,ierr);CHKERRQ(ierr)
   406)     call VecRestoreArrayF90(X,X_p,ierr);CHKERRQ(ierr)
   407)     call VecGetArrayF90(field%flow_r,r_p,ierr);CHKERRQ(ierr)
   408)   endif
   409) 
   410) end subroutine PMRichardsCheckUpdatePre
   411) 
   412) ! ************************************************************************** !
   413) 
   414) subroutine PMRichardsCheckUpdatePost(this,line_search,X0,dX,X1,dX_changed, &
   415)                                      X1_changed,ierr)
   416)   ! 
   417)   ! Author: Glenn Hammond
   418)   ! Date: 03/14/13
   419)   ! 
   420)   use Realization_Subsurface_class
   421)   use Grid_module
   422)   use Field_module
   423)   use Option_module
   424)   use Richards_Aux_module
   425)   use Global_Aux_module
   426)   use Material_Aux_class
   427)   use Patch_module
   428)   use Richards_Common_module
   429) 
   430)   implicit none
   431)   
   432)   class(pm_richards_type) :: this
   433)   SNESLineSearch :: line_search
   434)   Vec :: X0
   435)   Vec :: dX
   436)   Vec :: X1
   437)   PetscBool :: dX_changed
   438)   PetscBool :: X1_changed
   439)   PetscErrorCode :: ierr
   440)   
   441)   PetscReal, pointer :: X0_p(:)
   442)   PetscReal, pointer :: dX_p(:)
   443)   PetscReal, pointer :: r_p(:)
   444)   type(grid_type), pointer :: grid
   445)   type(option_type), pointer :: option
   446)   type(field_type), pointer :: field
   447)   type(patch_type), pointer :: patch
   448)   type(richards_auxvar_type), pointer :: rich_auxvars(:)
   449)   type(global_auxvar_type), pointer :: global_auxvars(:)  
   450)   class(material_auxvar_type), pointer :: material_auxvars(:)  
   451)   PetscInt :: local_id, ghosted_id
   452)   PetscInt :: istart
   453)   PetscReal :: Res(1)
   454)   PetscReal :: inf_norm, global_inf_norm
   455)   
   456)   patch => this%realization%patch
   457)   grid => patch%grid
   458)   option => this%realization%option
   459)   field => this%realization%field
   460)   rich_auxvars => patch%aux%Richards%auxvars
   461)   global_auxvars => patch%aux%Global%auxvars
   462)   material_auxvars => patch%aux%Material%auxvars
   463)   
   464)   dX_changed = PETSC_FALSE
   465)   X1_changed = PETSC_FALSE
   466)   
   467)   option%converged = PETSC_FALSE
   468)   if (this%check_post_convergence) then
   469)     call VecGetArrayF90(dX,dX_p,ierr);CHKERRQ(ierr)
   470)     call VecGetArrayF90(X0,X0_p,ierr);CHKERRQ(ierr)
   471)     call VecGetArrayF90(field%flow_r,r_p,ierr);CHKERRQ(ierr)
   472)     
   473)     inf_norm = 0.d0
   474)     do local_id = 1, grid%nlmax
   475)       ghosted_id = grid%nL2G(local_id)
   476)       istart = (local_id-1)*option%nflowdof + 1
   477) 
   478)       if (patch%imat(ghosted_id) <= 0) cycle
   479)     
   480)       call RichardsAccumulation(rich_auxvars(ghosted_id), &
   481)                                 global_auxvars(ghosted_id), &
   482)                                 material_auxvars(ghosted_id), &
   483)                                 option,Res)
   484)       inf_norm = max(inf_norm,min(dabs(dX_p(local_id)/X0_p(local_id)), &
   485)                                   dabs(r_p(istart)/Res(1))))
   486)     enddo
   487)     call MPI_Allreduce(inf_norm,global_inf_norm,ONE_INTEGER_MPI, &
   488)                        MPI_DOUBLE_PRECISION, &
   489)                        MPI_MAX,option%mycomm,ierr)
   490)     option%converged = PETSC_TRUE
   491)     if (global_inf_norm > richards_itol_scaled_res) &
   492)       option%converged = PETSC_FALSE
   493)     call VecRestoreArrayF90(dX,dX_p,ierr);CHKERRQ(ierr)
   494)     call VecRestoreArrayF90(X0,X0_p,ierr);CHKERRQ(ierr)
   495)     call VecGetArrayF90(field%flow_r,r_p,ierr);CHKERRQ(ierr)
   496)   endif
   497) 
   498) end subroutine PMRichardsCheckUpdatePost
   499) 
   500) ! ************************************************************************** !
   501) 
   502) subroutine PMRichardsTimeCut(this)
   503)   ! 
   504)   ! Author: Glenn Hammond
   505)   ! Date: 03/14/13
   506)   ! 
   507) 
   508)   use Richards_module, only : RichardsTimeCut
   509) 
   510)   implicit none
   511)   
   512)   class(pm_richards_type) :: this
   513)   
   514)   call PMSubsurfaceFlowTimeCut(this)
   515)   call RichardsTimeCut(this%realization)
   516) 
   517) end subroutine PMRichardsTimeCut
   518) 
   519) ! ************************************************************************** !
   520) 
   521) subroutine PMRichardsUpdateSolution(this)
   522)   ! 
   523)   ! Author: Glenn Hammond
   524)   ! Date: 03/14/13
   525)   ! 
   526) 
   527)   use Richards_module, only : RichardsUpdateSolution, &
   528)                               RichardsUpdateSurfacePress
   529) 
   530)   implicit none
   531)   
   532)   class(pm_richards_type) :: this
   533)   
   534)   call PMSubsurfaceFlowUpdateSolution(this)
   535)   call RichardsUpdateSolution(this%realization)
   536)   if (this%option%surf_flow_on) &
   537)     call RichardsUpdateSurfacePress(this%realization)
   538) 
   539) end subroutine PMRichardsUpdateSolution     
   540) 
   541) ! ************************************************************************** !
   542) 
   543) subroutine PMRichardsUpdateAuxVars(this)
   544)   ! 
   545)   ! Author: Glenn Hammond
   546)   ! Date: 04/21/14
   547) 
   548)   use Richards_module, only : RichardsUpdateAuxVars
   549)   
   550)   implicit none
   551)   
   552)   class(pm_richards_type) :: this
   553) 
   554)   call RichardsUpdateAuxVars(this%realization)
   555) 
   556) end subroutine PMRichardsUpdateAuxVars   
   557) 
   558) ! ************************************************************************** !
   559) 
   560) subroutine PMRichardsMaxChange(this)
   561)   ! 
   562)   ! Not needed given RichardsMaxChange is called in PostSolve
   563)   ! 
   564)   ! Author: Glenn Hammond
   565)   ! Date: 03/14/13
   566)   ! 
   567) 
   568)   use Richards_module, only : RichardsMaxChange
   569) 
   570)   implicit none
   571)   
   572)   class(pm_richards_type) :: this
   573)   
   574)   call RichardsMaxChange(this%realization,this%max_pressure_change)
   575)   if (this%option%print_screen_flag) then
   576)     write(*,'("  --> max chng: dpmx= ",1pe12.4)') this%max_pressure_change
   577)   endif
   578)   if (this%option%print_file_flag) then
   579)     write(this%option%fid_out,'("  --> max chng: dpmx= ",1pe12.4)') &
   580)       this%max_pressure_change
   581)   endif    
   582) 
   583) end subroutine PMRichardsMaxChange
   584) 
   585) ! ************************************************************************** !
   586) 
   587) subroutine PMRichardsComputeMassBalance(this,mass_balance_array)
   588)   ! 
   589)   ! Author: Glenn Hammond
   590)   ! Date: 03/14/13
   591)   ! 
   592) 
   593)   use Richards_module, only : RichardsComputeMassBalance
   594) 
   595)   implicit none
   596)   
   597)   class(pm_richards_type) :: this
   598)   PetscReal :: mass_balance_array(:)
   599)   
   600)   call RichardsComputeMassBalance(this%realization,mass_balance_array)
   601) 
   602) end subroutine PMRichardsComputeMassBalance
   603) 
   604) ! ************************************************************************** !
   605) 
   606) subroutine PMRichardsInputRecord(this)
   607)   ! 
   608)   ! Writes ingested information to the input record file.
   609)   ! 
   610)   ! Author: Jenn Frederick, SNL
   611)   ! Date: 03/21/2016
   612)   ! 
   613)   
   614)   implicit none
   615)   
   616)   class(pm_richards_type) :: this
   617) 
   618)   character(len=MAXWORDLENGTH) :: word
   619)   PetscInt :: id
   620) 
   621)   id = INPUT_RECORD_UNIT
   622) 
   623)   write(id,'(a29)',advance='no') 'pm: '
   624)   write(id,'(a)') this%name
   625)   write(id,'(a29)',advance='no') 'mode: '
   626)   write(id,'(a)') 'richards'
   627)   if (this%check_post_convergence) then
   628)     write(id,'(a29)',advance='no') 'ITOL_SCALED_RESIDUAL: '
   629)     write(id,'(a)') 'ON'
   630)     write(id,'(a29)',advance='no') 'ITOL_RELATIVE_UPDATE: '
   631)     write(id,'(a)') 'ON'
   632)   endif
   633) 
   634) end subroutine PMRichardsInputRecord
   635) 
   636) ! ************************************************************************** !
   637) 
   638) subroutine PMRichardsDestroy(this)
   639)   ! 
   640)   ! Destroys Richards process model
   641)   ! 
   642)   ! Author: Glenn Hammond
   643)   ! Date: 03/14/13
   644)   ! 
   645) 
   646)   use Richards_module, only : RichardsDestroy
   647) 
   648)   implicit none
   649)   
   650)   class(pm_richards_type) :: this
   651)   
   652)   if (associated(this%next)) then
   653)     call this%next%Destroy()
   654)   endif
   655) 
   656)   ! preserve this ordering
   657)   call RichardsDestroy(this%realization)
   658)   call PMSubsurfaceFlowDestroy(this)
   659)   
   660) end subroutine PMRichardsDestroy
   661)   
   662) end module PM_Richards_class

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