reaction_immobile_aux.F90       coverage:  90.91 %func     80.63 %block


     1) module Reaction_Immobile_Aux_module
     2)   
     3)   use Reaction_Database_Aux_module
     4) 
     5)   use PFLOTRAN_Constants_module
     6) 
     7)   implicit none
     8)   
     9)   private 
    10) 
    11) #include "petsc/finclude/petscsys.h"
    12) 
    13)   type, public :: immobile_species_type
    14)     PetscInt :: id
    15)     character(len=MAXWORDLENGTH) :: name
    16)     PetscReal :: molar_weight
    17)     PetscBool :: print_me
    18)     type(immobile_species_type), pointer :: next    
    19)   end type immobile_species_type
    20)   
    21)   type, public :: immobile_constraint_type
    22)     ! Any changes here must be incorporated within ReactionProcessConstraint()
    23)     ! where constraints are reordered
    24)     character(len=MAXWORDLENGTH), pointer :: names(:)
    25)     PetscReal, pointer :: constraint_conc(:)
    26)     character(len=MAXWORDLENGTH), pointer :: constraint_aux_string(:)
    27)     PetscBool, pointer :: external_dataset(:)
    28)   end type immobile_constraint_type
    29)   
    30)   type, public :: immobile_decay_rxn_type
    31)     PetscInt :: id
    32)     character(len=MAXWORDLENGTH) :: species_name
    33)     PetscReal :: rate_constant
    34)     PetscReal :: half_life
    35)     PetscBool :: print_me
    36)     type(immobile_decay_rxn_type), pointer :: next
    37)   end type immobile_decay_rxn_type
    38)   
    39)   type, public :: immobile_type
    40) 
    41)     PetscInt :: nimmobile
    42)     PetscBool :: print_all
    43)     
    44)     type(immobile_species_type), pointer :: list
    45)     type(immobile_decay_rxn_type), pointer :: decay_rxn_list
    46) 
    47)     ! immobile species
    48)     character(len=MAXWORDLENGTH), pointer :: names(:)
    49)     PetscBool, pointer :: print_me(:)    
    50)     
    51)     ! decay rxn
    52)     PetscInt :: ndecay_rxn
    53)     PetscInt, pointer :: decayspecid(:)
    54)     PetscReal, pointer :: decay_rate_constant(:)    
    55) 
    56)   end type immobile_type
    57)   
    58)   interface GetImmobileSpeciesIDFromName
    59)     module procedure GetImmobileSpeciesIDFromName1
    60)     module procedure GetImmobileSpeciesIDFromName2
    61)   end interface  
    62) 
    63)   public :: ImmobileCreate, &
    64)             ImmobileSpeciesCreate, &
    65)             ImmobileConstraintCreate, &
    66)             ImmobileDecayRxnCreate, &
    67)             ImmobileGetCount, &
    68)             ImmobileConstraintDestroy, &
    69)             GetImmobileSpeciesIDFromName, &
    70)             ImmobileDestroy
    71)              
    72) contains
    73) 
    74) ! ************************************************************************** !
    75) 
    76) function ImmobileCreate()
    77)   ! 
    78)   ! Allocate and initialize immobile object
    79)   ! 
    80)   ! Author: Glenn Hammond
    81)   ! Date: 01/11/13
    82)   ! 
    83) 
    84)   implicit none
    85)   
    86)   type(immobile_type), pointer :: ImmobileCreate
    87)   
    88)   type(immobile_type), pointer :: immobile
    89) 
    90)   allocate(immobile)  
    91)   nullify(immobile%list)
    92)   nullify(immobile%decay_rxn_list)
    93)   immobile%nimmobile = 0
    94)   immobile%print_all = PETSC_FALSE
    95)   nullify(immobile%names)
    96)   nullify(immobile%print_me)
    97)   
    98)   immobile%ndecay_rxn = 0
    99)   nullify(immobile%decayspecid)
   100)   nullify(immobile%decay_rate_constant)
   101) 
   102)   ImmobileCreate => immobile
   103)   
   104) end function ImmobileCreate
   105) 
   106) ! ************************************************************************** !
   107) 
   108) function ImmobileSpeciesCreate()
   109)   ! 
   110)   ! Allocate and initialize a immobile species object
   111)   ! 
   112)   ! Author: Glenn Hammond
   113)   ! Date: 01/02/13
   114)   ! 
   115) 
   116)   implicit none
   117)   
   118)   type(immobile_species_type), pointer :: ImmobileSpeciesCreate
   119)   
   120)   type(immobile_species_type), pointer :: species
   121) 
   122)   allocate(species)  
   123)   species%id = 0
   124)   species%name = ''
   125)   species%molar_weight = 0.d0
   126)   species%print_me = PETSC_FALSE
   127)   nullify(species%next)
   128) 
   129)   ImmobileSpeciesCreate => species
   130)   
   131) end function ImmobileSpeciesCreate
   132) 
   133) ! ************************************************************************** !
   134) 
   135) function ImmobileConstraintCreate(immobile,option)
   136)   ! 
   137)   ! Creates a immobile constraint object
   138)   ! 
   139)   ! Author: Glenn Hammond
   140)   ! Date: 01/07/13
   141)   ! 
   142) 
   143)   use Option_module
   144)   
   145)   implicit none
   146)   
   147)   type(immobile_type) :: immobile
   148)   type(option_type) :: option
   149)   type(immobile_constraint_type), pointer :: ImmobileConstraintCreate
   150) 
   151)   type(immobile_constraint_type), pointer :: constraint  
   152) 
   153)   allocate(constraint)
   154)   allocate(constraint%names(immobile%nimmobile))
   155)   constraint%names = ''
   156)   allocate(constraint%constraint_conc(immobile%nimmobile))
   157)   constraint%constraint_conc = 0.d0
   158)   allocate(constraint%constraint_aux_string(immobile%nimmobile))
   159)   constraint%constraint_aux_string = ''
   160)   allocate(constraint%external_dataset(immobile%nimmobile))
   161)   constraint%external_dataset = PETSC_FALSE
   162) 
   163)   ImmobileConstraintCreate => constraint
   164) 
   165) end function ImmobileConstraintCreate
   166) 
   167) ! ************************************************************************** !
   168) 
   169) function ImmobileDecayRxnCreate()
   170)   ! 
   171)   ! Allocate and initialize a immobile decay reaction
   172)   ! 
   173)   ! Author: Glenn Hammond
   174)   ! Date: 03/31/15
   175)   ! 
   176) 
   177)   implicit none
   178)     
   179)   type(immobile_decay_rxn_type), pointer :: ImmobileDecayRxnCreate
   180) 
   181)   type(immobile_decay_rxn_type), pointer :: rxn
   182)   
   183)   allocate(rxn)
   184)   rxn%id = 0
   185)   rxn%species_name = ''
   186)   rxn%rate_constant = 0.d0
   187)   rxn%half_life = 0.d0
   188)   rxn%print_me = PETSC_FALSE
   189)   nullify(rxn%next)
   190)   
   191)   ImmobileDecayRxnCreate => rxn
   192)   
   193) end function ImmobileDecayRxnCreate
   194) 
   195) ! ************************************************************************** !
   196) 
   197) function ImmobileGetCount(immobile)
   198)   ! 
   199)   ! Returns the number of immobile species
   200)   ! 
   201)   ! Author: Glenn Hammond
   202)   ! Date: 01/02/13
   203)   ! 
   204) 
   205)   implicit none
   206)   
   207)   PetscInt :: ImmobileGetCount
   208)   type(immobile_type) :: immobile
   209) 
   210)   type(immobile_species_type), pointer :: immobile_species
   211) 
   212)   ImmobileGetCount = 0
   213)   immobile_species => immobile%list
   214)   do
   215)     if (.not.associated(immobile_species)) exit
   216)     ImmobileGetCount = ImmobileGetCount + 1
   217)     immobile_species => immobile_species%next
   218)   enddo
   219) 
   220) end function ImmobileGetCount
   221) 
   222) ! ************************************************************************** !
   223) 
   224) function GetImmobileSpeciesIDFromName1(name,immobile,option)
   225)   ! 
   226)   ! Returns the id of named immobile species
   227)   ! 
   228)   ! Author: Glenn Hammond
   229)   ! Date: 01/28/13
   230)   ! 
   231) 
   232)   use Option_module
   233)   use String_module
   234)   
   235)   implicit none
   236)   
   237)   character(len=MAXWORDLENGTH) :: name
   238)   type(immobile_type) :: immobile
   239)   type(option_type) :: option
   240)   
   241)   PetscInt :: GetImmobileSpeciesIDFromName1
   242) 
   243)   GetImmobileSpeciesIDFromName1 = &
   244)     GetImmobileSpeciesIDFromName2(name,immobile,PETSC_TRUE,option)
   245)   
   246) end function GetImmobileSpeciesIDFromName1
   247) 
   248) ! ************************************************************************** !
   249) 
   250) function GetImmobileSpeciesIDFromName2(name,immobile,return_error,option)
   251)   ! 
   252)   ! Returns the id of named immobile species
   253)   ! 
   254)   ! Author: Glenn Hammond
   255)   ! Date: 01/28/13
   256)   ! 
   257) 
   258)   use Option_module
   259)   use String_module
   260)   
   261)   implicit none
   262)   
   263)   character(len=MAXWORDLENGTH) :: name
   264)   type(immobile_type) :: immobile
   265)   PetscBool :: return_error
   266)   type(option_type) :: option
   267) 
   268)   PetscInt :: GetImmobileSpeciesIDFromName2
   269) 
   270)   type(immobile_species_type), pointer :: species
   271)   PetscInt :: i
   272) 
   273)   GetImmobileSpeciesIDFromName2 = UNINITIALIZED_INTEGER
   274)   
   275)   ! if the primary species name list exists
   276)   if (associated(immobile%names)) then
   277)     do i = 1, size(immobile%names)
   278)       if (StringCompare(name,immobile%names(i), &
   279)                         MAXWORDLENGTH)) then
   280)         GetImmobileSpeciesIDFromName2 = i
   281)         exit
   282)       endif
   283)     enddo
   284)   else
   285)     species => immobile%list
   286)     i = 0
   287)     do
   288)       if (.not.associated(species)) exit
   289)       i = i + 1
   290)       if (StringCompare(name,species%name,MAXWORDLENGTH)) then
   291)         GetImmobileSpeciesIDFromName2 = i
   292)         exit
   293)       endif
   294)       species => species%next
   295)     enddo
   296)   endif
   297) 
   298)   if (return_error .and. GetImmobileSpeciesIDFromName2 <= 0) then
   299)     option%io_buffer = 'Species "' // trim(name) // &
   300)       '" not founds among immobile species in GetImmobileSpeciesIDFromName().'
   301)     call printErrMsg(option)
   302)   endif
   303)   
   304) end function GetImmobileSpeciesIDFromName2
   305) 
   306) ! ************************************************************************** !
   307) 
   308) subroutine ImmobileSpeciesDestroy(species)
   309)   ! 
   310)   ! Deallocates a immobile species
   311)   ! 
   312)   ! Author: Glenn Hammond
   313)   ! Date: 01/02/13
   314)   ! 
   315) 
   316)   implicit none
   317)     
   318)   type(immobile_species_type), pointer :: species
   319) 
   320)   if (.not.associated(species)) return
   321)   
   322)   deallocate(species)  
   323)   nullify(species)
   324) 
   325) end subroutine ImmobileSpeciesDestroy
   326) 
   327) ! ************************************************************************** !
   328) 
   329) recursive subroutine ImmobileDecayRxnDestroy(rxn)
   330)   ! 
   331)   ! Deallocates a general reaction
   332)   ! 
   333)   ! Author: Glenn Hammond
   334)   ! Date: 03/31/15
   335)   ! 
   336) 
   337)   implicit none
   338)     
   339)   type(immobile_decay_rxn_type), pointer :: rxn
   340) 
   341)   if (.not.associated(rxn)) return
   342)   
   343)   call ImmobileDecayRxnDestroy(rxn%next)
   344)   nullify(rxn%next)
   345)   deallocate(rxn)  
   346)   nullify(rxn)
   347) 
   348) end subroutine ImmobileDecayRxnDestroy
   349) 
   350) ! ************************************************************************** !
   351) 
   352) subroutine ImmobileConstraintDestroy(constraint)
   353)   ! 
   354)   ! Destroys a colloid constraint object
   355)   ! 
   356)   ! Author: Glenn Hammond
   357)   ! Date: 03/12/10
   358)   ! 
   359) 
   360)   use Utility_module, only: DeallocateArray
   361) 
   362)   implicit none
   363)   
   364)   type(immobile_constraint_type), pointer :: constraint
   365)   
   366)   if (.not.associated(constraint)) return
   367)   
   368)   call DeallocateArray(constraint%names)
   369)   call DeallocateArray(constraint%constraint_conc)
   370)   call DeallocateArray(constraint%constraint_aux_string)
   371)   call DeallocateArray(constraint%external_dataset)
   372)   
   373)   deallocate(constraint)
   374)   nullify(constraint)
   375) 
   376) end subroutine ImmobileConstraintDestroy
   377) 
   378) ! ************************************************************************** !
   379) 
   380) subroutine ImmobileDestroy(immobile)
   381)   ! 
   382)   ! Deallocates a immobile object
   383)   ! 
   384)   ! Author: Glenn Hammond
   385)   ! Date: 05/29/08
   386)   ! 
   387) 
   388)   use Utility_module, only: DeallocateArray
   389)   
   390)   implicit none
   391) 
   392)   type(immobile_type), pointer :: immobile
   393)   
   394)   type(immobile_species_type), pointer :: cur_immobile_species, &
   395)                                          prev_immobile_species
   396) 
   397)   if (.not.associated(immobile)) return
   398) 
   399)   ! immobile species
   400)   cur_immobile_species => immobile%list
   401)   do
   402)     if (.not.associated(cur_immobile_species)) exit
   403)     prev_immobile_species => cur_immobile_species
   404)     cur_immobile_species => cur_immobile_species%next
   405)     call ImmobileSpeciesDestroy(prev_immobile_species)
   406)   enddo    
   407)   nullify(immobile%list)
   408)   
   409)   call DeallocateArray(immobile%names)
   410)   call DeallocateArray(immobile%print_me)
   411)   
   412)   call ImmobileDecayRxnDestroy(immobile%decay_rxn_list)
   413)   call DeallocateArray(immobile%decayspecid)
   414)   call DeallocateArray(immobile%decay_rate_constant)
   415)   
   416)   deallocate(immobile)
   417)   nullify(immobile)
   418) 
   419) end subroutine ImmobileDestroy
   420) 
   421) end module Reaction_Immobile_Aux_module

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