transport_constraint.F90       coverage:  88.89 %func     68.41 %block


     1) module Transport_Constraint_module
     2)  
     3)   use Reaction_Aux_module
     4)   use Reactive_Transport_Aux_module
     5)   use Global_Aux_module
     6)   
     7)   use Reaction_Surface_Complexation_Aux_module  
     8)   use Reaction_Mineral_Aux_module
     9)   use Reaction_Immobile_Aux_module
    10)   
    11)   use PFLOTRAN_Constants_module
    12) 
    13)   implicit none
    14) 
    15)   private
    16)   
    17) #include "petsc/finclude/petscsys.h"
    18) 
    19)   ! concentration subcondition types
    20)   PetscInt, parameter, public :: CONSTRAINT_NULL = 0
    21)   PetscInt, parameter, public :: CONSTRAINT_FREE = 1
    22)   PetscInt, parameter, public :: CONSTRAINT_TOTAL = 2
    23)   PetscInt, parameter, public :: CONSTRAINT_LOG = 3
    24)   PetscInt, parameter, public :: CONSTRAINT_PH = 4
    25)   PetscInt, parameter, public :: CONSTRAINT_MINERAL = 5
    26)   PetscInt, parameter, public :: CONSTRAINT_GAS = 6
    27)   PetscInt, parameter, public :: CONSTRAINT_CHARGE_BAL = 7
    28)   PetscInt, parameter, public :: CONSTRAINT_TOTAL_SORB = 9
    29)   PetscInt, parameter, public :: CONSTRAINT_SUPERCRIT_CO2 = 10
    30) 
    31)   type, public :: tran_constraint_type
    32)     PetscInt :: id
    33)     character(len=MAXWORDLENGTH) :: name         
    34)     type(aq_species_constraint_type), pointer :: aqueous_species
    35)     type(guess_constraint_type), pointer :: free_ion_guess
    36)     type(mineral_constraint_type), pointer :: minerals
    37)     type(srfcplx_constraint_type), pointer :: surface_complexes
    38)     type(colloid_constraint_type), pointer :: colloids
    39)     type(immobile_constraint_type), pointer :: immobile_species
    40)     PetscBool :: requires_equilibration
    41)     type(tran_constraint_type), pointer :: next    
    42)   end type tran_constraint_type
    43)   
    44)   type, public :: tran_constraint_ptr_type
    45)     type(tran_constraint_type), pointer :: ptr
    46)   end type tran_constraint_ptr_type
    47)   
    48)   type, public :: tran_constraint_list_type
    49)     PetscInt :: num_constraints
    50)     type(tran_constraint_type), pointer :: first
    51)     type(tran_constraint_type), pointer :: last
    52)     type(tran_constraint_ptr_type), pointer :: array(:)    
    53)   end type tran_constraint_list_type
    54)   
    55)   type, public :: tran_constraint_coupler_type
    56)     character(len=MAXWORDLENGTH) :: constraint_name   
    57)     PetscReal :: time
    58)     PetscInt :: num_iterations
    59)     character(len=MAXWORDLENGTH) :: time_units
    60)     type(aq_species_constraint_type), pointer :: aqueous_species
    61)     type(guess_constraint_type), pointer :: free_ion_guess
    62)     type(mineral_constraint_type), pointer :: minerals
    63)     type(srfcplx_constraint_type), pointer :: surface_complexes
    64)     type(colloid_constraint_type), pointer :: colloids
    65)     type(immobile_constraint_type), pointer :: immobile_species
    66)     type(global_auxvar_type), pointer :: global_auxvar
    67)     type(reactive_transport_auxvar_type), pointer :: rt_auxvar
    68)     type(tran_constraint_coupler_type), pointer :: next   
    69)   end type tran_constraint_coupler_type
    70)       
    71)   public :: TranConstraintAddToList, &
    72)             TranConstraintInitList, &
    73)             TranConstraintDestroyList, &
    74)             TranConstraintGetPtrFromList, &
    75)             TranConstraintCreate, &
    76)             TranConstraintRead, &
    77)             TranConstraintDestroy, &
    78)             TranConstraintCouplerCreate, &
    79)             TranConstraintCouplerDestroy
    80)     
    81) contains
    82) 
    83) ! ************************************************************************** !
    84) 
    85) function TranConstraintCreate(option)
    86)   ! 
    87)   ! Creates a transport constraint (set of concentrations
    88)   ! and constraints for setting boundary or initial
    89)   ! condition).
    90)   ! 
    91)   ! Author: Glenn Hammond
    92)   ! Date: 10/14/08
    93)   ! 
    94) 
    95)   use Option_module
    96)   
    97)   implicit none
    98)   
    99)   type(option_type) :: option
   100)   type(tran_constraint_type), pointer :: TranConstraintCreate
   101)   
   102)   type(tran_constraint_type), pointer :: constraint
   103)   
   104)   allocate(constraint)
   105)   nullify(constraint%aqueous_species)
   106)   nullify(constraint%free_ion_guess)
   107)   nullify(constraint%minerals)
   108)   nullify(constraint%surface_complexes)
   109)   nullify(constraint%colloids)
   110)   nullify(constraint%immobile_species)
   111)   nullify(constraint%next)
   112)   constraint%id = 0
   113)   constraint%name = ''
   114)   constraint%requires_equilibration = PETSC_FALSE
   115)   
   116)   TranConstraintCreate => constraint
   117) 
   118) end function TranConstraintCreate
   119) 
   120) ! ************************************************************************** !
   121) 
   122) function TranConstraintCouplerCreate(option)
   123)   ! 
   124)   ! Creates a coupler that ties a constraint to a
   125)   ! transport condition
   126)   ! 
   127)   ! Author: Glenn Hammond
   128)   ! Date: 10/14/08
   129)   ! 
   130) 
   131)   use Option_module
   132)   
   133)   implicit none
   134)   
   135)   type(option_type) :: option
   136)   type(tran_constraint_coupler_type), pointer :: TranConstraintCouplerCreate
   137)   
   138)   type(tran_constraint_coupler_type), pointer :: coupler
   139)   
   140)   allocate(coupler)
   141)   nullify(coupler%aqueous_species)
   142)   nullify(coupler%free_ion_guess)
   143)   nullify(coupler%minerals)
   144)   nullify(coupler%surface_complexes)
   145)   nullify(coupler%colloids)
   146)   nullify(coupler%immobile_species)
   147)   
   148)   coupler%num_iterations = 0
   149)   nullify(coupler%rt_auxvar)
   150)   nullify(coupler%global_auxvar)
   151)   
   152)   nullify(coupler%next)
   153)   coupler%constraint_name = ''
   154)   coupler%time = 0.d0
   155)   coupler%time_units = ''
   156)   
   157)   TranConstraintCouplerCreate => coupler
   158) 
   159) end function TranConstraintCouplerCreate
   160) 
   161) ! ************************************************************************** !
   162) 
   163) subroutine TranConstraintRead(constraint,reaction,input,option)
   164)   ! 
   165)   ! Reads a transport constraint from the input file
   166)   ! 
   167)   ! Author: Glenn Hammond
   168)   ! Date: 10/14/08
   169)   ! 
   170) 
   171)   use Option_module
   172)   use Input_Aux_module
   173)   use Units_module
   174)   use String_module
   175)   use Logging_module
   176) 
   177)   implicit none
   178)   
   179)   type(tran_constraint_type) :: constraint
   180)   type(reaction_type) :: reaction
   181)   type(input_type), pointer :: input
   182)   type(option_type) :: option
   183)   
   184)   character(len=MAXSTRINGLENGTH) :: string
   185)   character(len=MAXWORDLENGTH) :: word
   186)   character(len=MAXWORDLENGTH) :: internal_units
   187)   character(len=MAXSTRINGLENGTH) :: block_string
   188)   PetscInt :: icomp, imnrl, iimmobile
   189)   PetscInt :: isrfcplx
   190)   PetscInt :: length
   191)   type(aq_species_constraint_type), pointer :: aq_species_constraint
   192)   type(guess_constraint_type), pointer :: free_ion_guess_constraint
   193)   type(mineral_constraint_type), pointer :: mineral_constraint
   194)   type(srfcplx_constraint_type), pointer :: srfcplx_constraint
   195)   type(colloid_constraint_type), pointer :: colloid_constraint
   196)   type(immobile_constraint_type), pointer :: immobile_constraint
   197)   PetscErrorCode :: ierr
   198)   PetscReal :: tempreal
   199) 
   200)   call PetscLogEventBegin(logging%event_tran_constraint_read, &
   201)                           ierr);CHKERRQ(ierr)
   202) 
   203)   ! read the constraint
   204)   input%ierr = 0
   205)   do
   206)   
   207)     call InputReadPflotranString(input,option)
   208)     call InputReadStringErrorMsg(input,option,'CONSTRAINT')
   209)         
   210)     if (InputCheckExit(input,option)) exit  
   211) 
   212)     call InputReadWord(input,option,word,PETSC_TRUE)
   213)     call InputErrorMsg(input,option,'keyword','CONSTRAINT')   
   214)       
   215)     select case(trim(word))
   216) 
   217)       case('CONC','CONCENTRATIONS')
   218) 
   219)         aq_species_constraint => &
   220)           AqueousSpeciesConstraintCreate(reaction,option)
   221) 
   222)         block_string = 'CONSTRAINT, CONCENTRATIONS'
   223)         icomp = 0
   224)         do
   225)           call InputReadPflotranString(input,option)
   226)           call InputReadStringErrorMsg(input,option,block_string)
   227)           
   228)           if (InputCheckExit(input,option)) exit  
   229)           
   230)           icomp = icomp + 1        
   231)           
   232)           if (icomp > reaction%naqcomp) then
   233)             option%io_buffer = 'Number of concentration constraints ' // &
   234)                                'exceeds number of primary chemical ' // &
   235)                                'components in constraint: ' // &
   236)                                 trim(constraint%name)
   237)             call printErrMsg(option)
   238)           endif
   239)           
   240)           call InputReadWord(input,option,aq_species_constraint%names(icomp), &
   241)                           PETSC_TRUE)
   242)           call InputErrorMsg(input,option,'aqueous species name',block_string)
   243)           option%io_buffer = 'Constraint Species: ' // &
   244)                              trim(aq_species_constraint%names(icomp))
   245)           call printMsg(option)
   246)           
   247)           call InputReadDouble(input,option, &
   248)                                aq_species_constraint%constraint_conc(icomp))
   249)           call InputErrorMsg(input,option,'concentration',block_string)
   250)           
   251)           call InputReadWord(input,option,word,PETSC_TRUE)
   252)           call InputDefaultMsg(input,option, &
   253)                                trim(block_string) // ' constraint_type')
   254)           length = len_trim(word)
   255)           if (length > 0) then
   256)             call StringToUpper(word)
   257)             select case(word)
   258)               case('F','FREE')
   259)                 aq_species_constraint%constraint_type(icomp) = CONSTRAINT_FREE
   260)               case('T','TOTAL')
   261)                 aq_species_constraint%constraint_type(icomp) = CONSTRAINT_TOTAL
   262)               case('TOTAL_SORB')
   263)                 aq_species_constraint%constraint_type(icomp) = &
   264)                   CONSTRAINT_TOTAL_SORB
   265)               case('S')
   266)                 option%io_buffer = '"S" constraint type no longer ' // &
   267)                   'supported as of March 4, 2013.'
   268)                 call printErrMsg(option)
   269)               case('P','PH')
   270)                 aq_species_constraint%constraint_type(icomp) = CONSTRAINT_PH
   271)               case('L','LOG')
   272)                 aq_species_constraint%constraint_type(icomp) = CONSTRAINT_LOG
   273)               case('M','MINERAL','MNRL') 
   274)                 aq_species_constraint%constraint_type(icomp) = &
   275)                   CONSTRAINT_MINERAL
   276)               case('G','GAS') 
   277)                 aq_species_constraint%constraint_type(icomp) = CONSTRAINT_GAS
   278)               case('SC','CONSTRAINT_SUPERCRIT_CO2') 
   279)                 aq_species_constraint%constraint_type(icomp) = &
   280)                   CONSTRAINT_SUPERCRIT_CO2
   281)               case('Z','CHG') 
   282)                 aq_species_constraint%constraint_type(icomp) = &
   283)                   CONSTRAINT_CHARGE_BAL
   284)               case default
   285)                 call InputKeywordUnrecognized(word, &
   286)                        'CONSTRAINT,CONCENTRATION,TYPE',option)
   287)             end select 
   288)             
   289)             if (aq_species_constraint%constraint_type(icomp) == &
   290)                   CONSTRAINT_MINERAL .or. &
   291)                 aq_species_constraint%constraint_type(icomp) == &
   292)                   CONSTRAINT_GAS .or.&
   293)                 aq_species_constraint%constraint_type(icomp) == &
   294)                   CONSTRAINT_SUPERCRIT_CO2) then
   295)               call InputReadWord(input,option,aq_species_constraint% &
   296)                                  constraint_aux_string(icomp), &
   297)                                  PETSC_TRUE)
   298)               call InputErrorMsg(input,option,'constraint name',block_string)
   299)             else
   300)               call InputReadWord(input,option,word,PETSC_FALSE)
   301)               if (input%ierr == 0) then
   302)                 call StringToUpper(word)
   303)                 select case(word)
   304)                   case('DATASET')
   305)                     call InputReadWord(input,option,aq_species_constraint% &
   306)                                        constraint_aux_string(icomp),PETSC_TRUE)
   307)                     call InputErrorMsg(input,option,'dataset name', &
   308)                                        block_string)
   309)                     aq_species_constraint%external_dataset(icomp) = PETSC_TRUE
   310)                 end select
   311)               endif
   312)             endif
   313)           else
   314)             aq_species_constraint%constraint_type(icomp) = CONSTRAINT_TOTAL
   315)           endif  
   316)         
   317)         enddo  
   318)         
   319)         if (icomp < reaction%naqcomp) then
   320)           option%io_buffer = &
   321)                    'Number of concentration constraints is less than ' // &
   322)                    'number of primary species in aqueous constraint.'
   323)           call printErrMsg(option)        
   324)         endif
   325)         if (icomp > reaction%naqcomp) then
   326)           option%io_buffer = &
   327)                    'Number of concentration constraints is greater than ' // &
   328)                    'number of primary species in aqueous constraint.'
   329)           call printWrnMsg(option)        
   330)         endif
   331)         
   332)         if (associated(constraint%aqueous_species)) &
   333)           call AqueousSpeciesConstraintDestroy(constraint%aqueous_species)
   334)         constraint%aqueous_species => aq_species_constraint 
   335)         
   336)       case('FREE_ION_GUESS')
   337) 
   338)         free_ion_guess_constraint => GuessConstraintCreate(reaction,option)
   339) 
   340)         block_string = 'CONSTRAINT, FREE_ION_GUESS'
   341)         icomp = 0
   342)         do
   343)           call InputReadPflotranString(input,option)
   344)           call InputReadStringErrorMsg(input,option,block_string)
   345)           
   346)           if (InputCheckExit(input,option)) exit  
   347)           
   348)           icomp = icomp + 1        
   349)           
   350)           if (icomp > reaction%naqcomp) then
   351)             option%io_buffer = 'Number of free ion guess constraints ' // &
   352)                                'exceeds number of primary chemical ' // &
   353)                                'components in constraint: ' // &
   354)                                 trim(constraint%name)
   355)             call printErrMsg(option)
   356)           endif
   357)           
   358)           call InputReadWord(input,option, &
   359)                              free_ion_guess_constraint%names(icomp), &
   360)                              PETSC_TRUE)
   361)           call InputErrorMsg(input,option,'free ion guess name',block_string)
   362)           option%io_buffer = 'Constraint Species: ' // &
   363)                              trim(free_ion_guess_constraint%names(icomp))
   364)           call printMsg(option)
   365)           
   366)           call InputReadDouble(input,option,free_ion_guess_constraint%conc(icomp))
   367)           call InputErrorMsg(input,option,'free ion guess',block_string)
   368)         enddo
   369) 
   370)         if (icomp < reaction%naqcomp) then
   371)           option%io_buffer = &
   372)                    'Number of free ion guess constraints is less than ' // &
   373)                    'number of primary species in aqueous constraint.'
   374)           call printErrMsg(option)        
   375)         endif
   376)         if (icomp > reaction%naqcomp) then
   377)           option%io_buffer = &
   378)                    'Number of free ion guess constraints is greater than ' // &
   379)                    'number of primary species in aqueous constraint.'
   380)           call printWrnMsg(option)        
   381)         endif
   382)         
   383)         if (associated(constraint%free_ion_guess)) &
   384)           call GuessConstraintDestroy(constraint%free_ion_guess)
   385)         constraint%free_ion_guess => free_ion_guess_constraint
   386)         nullify(free_ion_guess_constraint)
   387) 
   388)       case('MNRL','MINERALS')
   389) 
   390)         mineral_constraint => MineralConstraintCreate(reaction%mineral,option)
   391) 
   392)         block_string = 'CONSTRAINT, MINERALS'
   393)         imnrl = 0
   394)         do
   395)           call InputReadPflotranString(input,option)
   396)           call InputReadStringErrorMsg(input,option,block_string)
   397)           
   398)           if (InputCheckExit(input,option)) exit          
   399)           
   400)           imnrl = imnrl + 1
   401) 
   402)           if (imnrl > reaction%mineral%nkinmnrl) then
   403)             option%io_buffer = &
   404)                      'Number of mineral constraints exceeds number of ' // &
   405)                      'kinetic minerals in constraint: ' // &
   406)                       trim(constraint%name)
   407)             call printErrMsg(option)
   408)           endif
   409)           
   410)           call InputReadWord(input,option,mineral_constraint%names(imnrl), &
   411)                              PETSC_TRUE)
   412)           call InputErrorMsg(input,option,'mineral name',block_string)
   413)           option%io_buffer = 'Constraint Minerals: ' // &
   414)                              trim(mineral_constraint%names(imnrl))
   415)           call printMsg(option)
   416) 
   417)           ! volume fraction
   418)           string = trim(input%buf)
   419)           call InputReadWord(string,word,PETSC_TRUE,ierr)
   420)           ! if a dataset
   421)           if (StringCompareIgnoreCase(word,'DATASET')) then
   422)             input%buf = trim(string)
   423)             call InputReadWord(input,option,mineral_constraint% &
   424)                                 constraint_vol_frac_string(imnrl),PETSC_TRUE)
   425)             call InputErrorMsg(input,option,'dataset name', &
   426)                                trim(block_string) // ' VOL FRAC')
   427)             mineral_constraint%external_voL_frac_dataset(imnrl) = PETSC_TRUE
   428)             ! set vol frac to NaN to catch bugs
   429)             tempreal = -1.d0
   430)             mineral_constraint%constraint_vol_frac(imnrl) = sqrt(tempreal)
   431)           else
   432)             call InputReadDouble(input,option, &
   433)                                  mineral_constraint%constraint_vol_frac(imnrl))
   434)             call InputErrorMsg(input,option,'volume fraction',block_string)
   435)           endif
   436) 
   437)           string = trim(input%buf)
   438)           call InputReadWord(string,word,PETSC_TRUE,ierr)
   439)           ! if a dataset
   440)           if (StringCompareIgnoreCase(word,'DATASET')) then
   441)             input%buf = trim(string)
   442)             call InputReadWord(input,option,mineral_constraint% &
   443)                                 constraint_area_string(imnrl),PETSC_TRUE)
   444)             call InputErrorMsg(input,option,'dataset name', &
   445)                                trim(block_string) // ' SURF AREA')
   446)             mineral_constraint%external_area_dataset(imnrl) = PETSC_TRUE
   447)             ! set surface area to NaN to catch bugs
   448)             tempreal = -1.d0
   449)             mineral_constraint%constraint_area(imnrl) = sqrt(tempreal)
   450)             ! read units if they exist
   451)             internal_units = 'm^2/m^3'
   452)             call InputReadWord(input,option,word,PETSC_TRUE)
   453)             if (.not.InputError(input)) then
   454)               ! convert just to ensure that the units were properly set
   455)               tempreal = UnitsConvertToInternal(word,internal_units,option)
   456)               option%io_buffer = 'If mineral specific surface areas are ' // &
   457)                 'defined through a DATASET, their units must be SI ' // &
   458)                 '[m^2/m^3].  Unit conversion cannot be performed as ' // &
   459)                 'currently implemented.'
   460)               call printErrMsg(option)        
   461)             endif
   462)           else
   463)             ! specific surface area
   464)             call InputReadDouble(input,option, &
   465)                                  mineral_constraint%constraint_area(imnrl))
   466)             call InputErrorMsg(input,option,'surface area',block_string)
   467)             ! read units if they exist
   468)             internal_units = 'm^2/m^3'
   469)             call InputReadWord(input,option,word,PETSC_TRUE)
   470)             if (InputError(input)) then
   471)               input%err_buf = trim(mineral_constraint%names(imnrl)) // &
   472)                                ' SPECIFIC SURFACE_AREA UNITS'
   473)               call InputDefaultMsg(input,option)
   474)             else
   475)               mineral_constraint%constraint_area(imnrl) = &
   476)                 mineral_constraint%constraint_area(imnrl) * &
   477)                 UnitsConvertToInternal(word,internal_units,option)
   478)             endif
   479)           endif
   480)         enddo  
   481)         
   482)         if (imnrl < reaction%mineral%nkinmnrl) then
   483)           option%io_buffer = &
   484)                    'Mineral lists in constraints must provide a volume ' // &
   485)                    'fraction and surface area for all kinetic minerals ' // &
   486)                    '(listed under MINERAL_KINETICS card in CHEMISTRY), ' // &
   487)                    'regardless of whether or not they are present (just ' // &
   488)                    'assign a zero volume fraction if not present).'
   489)           call printErrMsg(option)        
   490)         endif
   491)         
   492)         if (associated(constraint%minerals)) then
   493)           call MineralConstraintDestroy(constraint%minerals)
   494)         endif
   495)         constraint%minerals => mineral_constraint 
   496)                             
   497)       case('SURFACE_COMPLEXES')
   498)       
   499)         srfcplx_constraint => &
   500)           SurfaceComplexConstraintCreate(reaction%surface_complexation,option)
   501) 
   502)         block_string = 'CONSTRAINT, SURFACE_COMPLEXES'
   503)         isrfcplx = 0
   504)         do
   505)           call InputReadPflotranString(input,option)
   506)           call InputReadStringErrorMsg(input,option,block_string)
   507)           
   508)           if (InputCheckExit(input,option)) exit          
   509)           
   510)           isrfcplx = isrfcplx + 1
   511) 
   512)           if (isrfcplx > reaction%surface_complexation%nkinsrfcplx) then
   513)             option%io_buffer = &
   514)                      'Number of surface complex constraints exceeds ' // &
   515)                      'number of kinetic surface complexes in constraint: ' // &
   516)                       trim(constraint%name)
   517)             call printErrMsg(option)
   518)           endif
   519)           
   520)           call InputReadWord(input,option,srfcplx_constraint%names(isrfcplx), &
   521)                           PETSC_TRUE)
   522)           call InputErrorMsg(input,option,'surface complex name',block_string)
   523)           option%io_buffer = 'Constraint Surface Complex: ' // &
   524)                              trim(srfcplx_constraint%names(isrfcplx))
   525)           call printMsg(option)
   526)           call InputReadDouble(input,option, &
   527)                                srfcplx_constraint%constraint_conc(isrfcplx))
   528)           call InputErrorMsg(input,option,'concentration',block_string)
   529)         enddo  
   530)         
   531)         if (isrfcplx < reaction%surface_complexation%nkinsrfcplx) then
   532)           option%io_buffer = &
   533)                    'Number of surface complex constraints is less than ' // &
   534)                    'number of kinetic surface complexes in surface ' // &
   535)                    'complex constraint.'
   536)           call printErrMsg(option)        
   537)         endif
   538)         
   539)         if (associated(constraint%surface_complexes)) then
   540)           call SurfaceComplexConstraintDestroy(constraint%surface_complexes)
   541)         endif
   542)         constraint%surface_complexes => srfcplx_constraint
   543)          
   544)       case('COLL','COLLOIDS')
   545) 
   546)         colloid_constraint => ColloidConstraintCreate(reaction,option)
   547) 
   548)         block_string = 'CONSTRAINT, COLLOIDS'
   549)         icomp = 0
   550)         do
   551)           call InputReadPflotranString(input,option)
   552)           call InputReadStringErrorMsg(input,option,block_string)
   553)           
   554)           if (InputCheckExit(input,option)) exit          
   555)           
   556)           icomp = icomp + 1
   557) 
   558)           if (icomp > reaction%ncoll) then
   559)             option%io_buffer = &
   560)                      'Number of colloid constraints exceeds number of ' // &
   561)                      'colloids in constraint: ' // &
   562)                       trim(constraint%name)
   563)             call printErrMsg(option)
   564)           endif
   565)           
   566)           call InputReadWord(input,option,colloid_constraint%names(icomp), &
   567)                           PETSC_TRUE)
   568)           call InputErrorMsg(input,option,'colloid name',block_string)
   569)           option%io_buffer = 'Constraint Colloids: ' // &
   570)                              trim(colloid_constraint%names(icomp))
   571)           call printMsg(option)
   572)           call InputReadDouble(input,option, &
   573)                                colloid_constraint%constraint_conc_mob(icomp))
   574)           call InputErrorMsg(input,option,'mobile concentration',block_string)
   575)           call InputReadDouble(input,option, &
   576)                                colloid_constraint%constraint_conc_imb(icomp))
   577)           call InputErrorMsg(input,option,'immobile concentration', &
   578)                              block_string)
   579)         
   580)         enddo  
   581)         
   582)         if (icomp < reaction%ncoll) then
   583)           option%io_buffer = &
   584)                    'Colloid lists in constraints must provide mobile ' // &
   585)                    'and immobile concentrations for all colloids ' // &
   586)                    '(listed under the COLLOIDS card in CHEMISTRY), ' // &
   587)                    'regardless of whether or not they are present (just ' // &
   588)                    'assign a small value (e.g. 1.d-40) if not present).'
   589)           call printErrMsg(option)        
   590)         endif
   591)         
   592)         if (associated(constraint%colloids)) then
   593)           call ColloidConstraintDestroy(constraint%colloids)
   594)         endif
   595)         constraint%colloids => colloid_constraint 
   596) 
   597)         
   598)         
   599)       case('IMMOBILE')
   600) 
   601)         immobile_constraint => &
   602)           ImmobileConstraintCreate(reaction%immobile,option)
   603) 
   604)         block_string = 'CONSTRAINT, IMMOBILE'
   605)         iimmobile = 0
   606)         do
   607)           call InputReadPflotranString(input,option)
   608)           call InputReadStringErrorMsg(input,option,block_string)
   609)           
   610)           if (InputCheckExit(input,option)) exit          
   611)           
   612)           iimmobile = iimmobile + 1
   613) 
   614)           if (iimmobile > reaction%immobile%nimmobile) then
   615)             option%io_buffer = &
   616)                      'Number of immobile constraints exceeds number of ' // &
   617)                      'immobile species in constraint: ' // &
   618)                       trim(constraint%name)
   619)             call printErrMsg(option)
   620)           endif
   621)           
   622)           call InputReadWord(input,option, &
   623)                              immobile_constraint%names(iimmobile),PETSC_TRUE)
   624)           call InputErrorMsg(input,option,'immobile name',block_string)
   625)           option%io_buffer = 'Constraint Immobile: ' // &
   626)                              trim(immobile_constraint%names(iimmobile))
   627)           call printMsg(option)
   628) 
   629)           ! concentration
   630)           string = trim(input%buf)
   631)           call InputReadWord(string,word,PETSC_TRUE,ierr)
   632)           ! if a dataset
   633)           if (StringCompareIgnoreCase(word,'DATASET')) then
   634)             input%buf = trim(string)
   635)             call InputReadWord(input,option,immobile_constraint% &
   636)                                 constraint_aux_string(iimmobile),PETSC_TRUE)
   637)             call InputErrorMsg(input,option,'dataset name', &
   638)                                trim(block_string) // ' concentration')
   639)             immobile_constraint%external_dataset(iimmobile) = PETSC_TRUE
   640)             ! set vol frac to NaN to catch bugs
   641)             tempreal = -1.d0
   642)             immobile_constraint%constraint_conc(iimmobile) = sqrt(tempreal)
   643)           else
   644)             call InputReadDouble(input,option, &
   645)                                  immobile_constraint%constraint_conc(iimmobile))
   646)             call InputErrorMsg(input,option,'concentration',block_string)
   647)           endif
   648) 
   649)           ! read units if they exist
   650)           internal_units = 'mol/m^3'
   651)           call InputReadWord(input,option,word,PETSC_TRUE)
   652)           if (InputError(input)) then
   653)             input%err_buf = trim(immobile_constraint%names(iimmobile)) // &
   654)                              ' IMMOBILE CONCENTRATION UNITS'
   655)             call InputDefaultMsg(input,option)
   656)           else
   657)             immobile_constraint%constraint_conc(iimmobile) = &
   658)               immobile_constraint%constraint_conc(iimmobile) * &
   659)               UnitsConvertToInternal(word,internal_units,option)
   660)           endif
   661)         enddo  
   662)         
   663)         if (iimmobile < reaction%immobile%nimmobile) then
   664)           option%io_buffer = &
   665)                    'Immobile lists in constraints must provide a ' // &
   666)                    'concentration for all immobile species ' // &
   667)                    '(listed under IMMOBILE card in CHEMISTRY), ' // &
   668)                    'regardless of whether or not they are present.'
   669)           call printErrMsg(option)        
   670)         endif
   671)         
   672)         if (associated(constraint%immobile_species)) then
   673)           call ImmobileConstraintDestroy(constraint%immobile_species)
   674)         endif
   675)         constraint%immobile_species => immobile_constraint 
   676)         
   677)       case default
   678)         call InputKeywordUnrecognized(word,'CONSTRAINT',option)
   679)     end select 
   680)   
   681)   enddo  
   682)   
   683)   call PetscLogEventEnd(logging%event_tran_constraint_read,ierr);CHKERRQ(ierr)
   684) 
   685) end subroutine TranConstraintRead
   686) 
   687) ! ************************************************************************** !
   688) 
   689) subroutine TranConstraintInitList(list)
   690)   ! 
   691)   ! Initializes a transport constraint list
   692)   ! 
   693)   ! Author: Glenn Hammond
   694)   ! Date: 10/14/08
   695)   ! 
   696) 
   697)   implicit none
   698) 
   699)   type(tran_constraint_list_type) :: list
   700)   
   701)   nullify(list%first)
   702)   nullify(list%last)
   703)   nullify(list%array)
   704)   list%num_constraints = 0
   705) 
   706) end subroutine TranConstraintInitList
   707) 
   708) ! ************************************************************************** !
   709) 
   710) subroutine TranConstraintAddToList(new_constraint,list)
   711)   ! 
   712)   ! Adds a new constraint to a transport constraint
   713)   ! list
   714)   ! 
   715)   ! Author: Glenn Hammond
   716)   ! Date: 10/14/08
   717)   ! 
   718) 
   719)   implicit none
   720)   
   721)   type(tran_constraint_type), pointer :: new_constraint
   722)   type(tran_constraint_list_type) :: list
   723)   
   724)   list%num_constraints = list%num_constraints + 1
   725)   new_constraint%id = list%num_constraints
   726)   if (.not.associated(list%first)) list%first => new_constraint
   727)   if (associated(list%last)) list%last%next => new_constraint
   728)   list%last => new_constraint
   729)   
   730) end subroutine TranConstraintAddToList
   731) 
   732) ! ************************************************************************** !
   733) 
   734) function TranConstraintGetPtrFromList(constraint_name,constraint_list)
   735)   ! 
   736)   ! Returns a pointer to the constraint matching
   737)   ! constraint_name
   738)   ! 
   739)   ! Author: Glenn Hammond
   740)   ! Date: 10/13/08
   741)   ! 
   742) 
   743)   use String_module
   744) 
   745)   implicit none
   746)   
   747)   type(tran_constraint_type), pointer :: TranConstraintGetPtrFromList
   748)   character(len=MAXWORDLENGTH) :: constraint_name
   749)   type(tran_constraint_list_type) :: constraint_list
   750)  
   751)   PetscInt :: length
   752)   type(tran_constraint_type), pointer :: constraint
   753)     
   754)   nullify(TranConstraintGetPtrFromList)
   755)   constraint => constraint_list%first
   756)   
   757)   do 
   758)     if (.not.associated(constraint)) exit
   759)     length = len_trim(constraint_name)
   760)     if (length == len_trim(constraint%name) .and. &
   761)         StringCompare(constraint%name,constraint_name, &
   762)                         length)) then
   763)       TranConstraintGetPtrFromList => constraint
   764)       return
   765)     endif
   766)     constraint => constraint%next
   767)   enddo
   768)   
   769) end function TranConstraintGetPtrFromList
   770) 
   771) ! ************************************************************************** !
   772) 
   773) subroutine TranConstraintDestroy(constraint)
   774)   ! 
   775)   ! Deallocates a constraint
   776)   ! 
   777)   ! Author: Glenn Hammond
   778)   ! Date: 10/14/08
   779)   ! 
   780) 
   781)   implicit none
   782)   
   783)   type(tran_constraint_type), pointer :: constraint
   784)   
   785)   if (.not.associated(constraint)) return
   786) 
   787)   if (associated(constraint%aqueous_species)) &
   788)     call AqueousSpeciesConstraintDestroy(constraint%aqueous_species)
   789)   nullify(constraint%aqueous_species)
   790)   if (associated(constraint%free_ion_guess)) &
   791)     call GuessConstraintDestroy(constraint%free_ion_guess)
   792)   nullify(constraint%free_ion_guess)
   793)   if (associated(constraint%minerals)) &
   794)     call MineralConstraintDestroy(constraint%minerals)
   795)   nullify(constraint%minerals)
   796)   if (associated(constraint%surface_complexes)) &
   797)     call SurfaceComplexConstraintDestroy(constraint%surface_complexes)
   798)   nullify(constraint%surface_complexes)
   799)   if (associated(constraint%colloids)) &
   800)     call ColloidConstraintDestroy(constraint%colloids)
   801)   nullify(constraint%colloids)
   802)   if (associated(constraint%immobile_species)) &
   803)     call ImmobileConstraintDestroy(constraint%immobile_species)
   804)   nullify(constraint%immobile_species)
   805) 
   806)   deallocate(constraint)
   807)   nullify(constraint)
   808) 
   809) end subroutine TranConstraintDestroy
   810) 
   811) ! ************************************************************************** !
   812) 
   813) subroutine TranConstraintDestroyList(constraint_list)
   814)   ! 
   815)   ! Deallocates a list of constraints
   816)   ! 
   817)   ! Author: Glenn Hammond
   818)   ! Date: 10/14/08
   819)   ! 
   820) 
   821)   implicit none
   822)   
   823)   type(tran_constraint_list_type), pointer :: constraint_list
   824)   
   825)   type(tran_constraint_type), pointer :: constraint, prev_constraint
   826)   
   827)   if (.not.associated(constraint_list)) return
   828)   
   829)   constraint => constraint_list%first
   830)   do 
   831)     if (.not.associated(constraint)) exit
   832)     prev_constraint => constraint
   833)     constraint => constraint%next
   834)     call TranConstraintDestroy(prev_constraint)
   835)   enddo
   836)   
   837)   constraint_list%num_constraints = 0
   838)   nullify(constraint_list%first)
   839)   nullify(constraint_list%last)
   840)   if (associated(constraint_list%array)) deallocate(constraint_list%array)
   841)   nullify(constraint_list%array)
   842)   
   843)   deallocate(constraint_list)
   844)   nullify(constraint_list)
   845) 
   846) end subroutine TranConstraintDestroyList
   847) 
   848) ! ************************************************************************** !
   849) 
   850) subroutine TranConstraintCouplerDestroy(coupler_list)
   851)   ! 
   852)   ! Destroys a constraint coupler linked list
   853)   ! 
   854)   ! Author: Glenn Hammond
   855)   ! Date: 10/14/08
   856)   ! 
   857) 
   858)   use Option_module
   859)   
   860)   implicit none
   861)   
   862)   type(tran_constraint_coupler_type), pointer :: coupler_list
   863)   
   864)   type(tran_constraint_coupler_type), pointer :: cur_coupler, prev_coupler
   865)   
   866)   cur_coupler => coupler_list
   867)   
   868)   do
   869)     if (.not.associated(cur_coupler)) exit
   870)     prev_coupler => cur_coupler
   871)     cur_coupler => cur_coupler%next
   872)     if (associated(prev_coupler%rt_auxvar)) then
   873)       call RTAuxVarDestroy(prev_coupler%rt_auxvar)
   874)     endif
   875)     nullify(prev_coupler%rt_auxvar)
   876)     if (associated(prev_coupler%global_auxvar)) then
   877)       call GlobalAuxVarDestroy(prev_coupler%global_auxvar)
   878)     endif
   879)     nullify(prev_coupler%global_auxvar)
   880)     nullify(prev_coupler%aqueous_species)
   881)     nullify(prev_coupler%minerals)
   882)     nullify(prev_coupler%surface_complexes)
   883)     nullify(prev_coupler%colloids)
   884)     nullify(prev_coupler%immobile_species)
   885)     nullify(prev_coupler%next)
   886)     deallocate(prev_coupler)
   887)     nullify(prev_coupler)
   888)   enddo
   889)   
   890)   nullify(coupler_list)
   891)   
   892) end subroutine TranConstraintCouplerDestroy
   893) 
   894) end module Transport_Constraint_module

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