input_aux.F90       coverage:  88.68 %func     71.28 %block


     1) module Input_Aux_module
     2) 
     3)   use Option_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 :: input_type 
    14)     PetscInt :: fid
    15)     PetscErrorCode :: ierr
    16)     character(len=MAXWORDLENGTH) :: filename
    17)     character(len=MAXSTRINGLENGTH) :: buf
    18)     character(len=MAXSTRINGLENGTH) :: err_buf
    19)     character(len=MAXSTRINGLENGTH) :: err_buf2
    20)     PetscBool :: broadcast_read
    21)     PetscBool :: force_units ! force user to declare units on datasets
    22)     type(input_type), pointer :: parent
    23)   end type input_type
    24) 
    25)   type :: input_dbase_type
    26)     character(len=MAXWORDLENGTH), pointer :: icard(:)
    27)     character(len=MAXWORDLENGTH), pointer :: rcard(:)
    28)     character(len=MAXWORDLENGTH), pointer :: ccard(:)
    29)     PetscInt, pointer :: ivalue(:)
    30)     PetscReal, pointer :: rvalue(:)
    31)     character(len=MAXWORDLENGTH), pointer :: cvalue(:)
    32)   end type input_dbase_type
    33) 
    34)   type(input_dbase_type), pointer, public :: dbase => null()
    35) 
    36)   interface InputReadWord
    37)     module procedure InputReadWord1
    38)     module procedure InputReadWord2
    39)   end interface
    40)   
    41)   interface InputReadNChars
    42)     module procedure InputReadNChars1
    43)     module procedure InputReadNChars2
    44)   end interface
    45)   
    46)   interface InputReadInt
    47)     module procedure InputReadInt1
    48)     module procedure InputReadInt2
    49) #if defined(PETSC_USE_64BIT_INDICES) && (PETSC_SIZEOF_MPI_FINT * PETSC_BITS_PER_BYTE != 64)
    50)     ! If PetscInt and PetscMPIInt have different sizes (occurs for some builds
    51)     ! with 64 bit indices), then we need to have additional routines for the 
    52)     ! InputReadInt() generic subroutine.  (We use the above check instead of 
    53)     ! directly checking to see if PetscInt and PetscMPIInt have the same size
    54)     ! because the size of PetscInt is not included in the 
    55)     ! $PETSC_DIR/$PETSC_ARCH/include/petscconf.h file.) If the two types have
    56)     ! the same size, then these additional routines for type PetscMPIInt must
    57)     ! *not* be defined, because then the interface becomes ambiguous, since 
    58)     ! Fortran doesn't know the difference between PetscInt and PetscMPIInt if
    59)     ! they are identically sized integers.  --RTM
    60)     module procedure InputReadInt3
    61)     module procedure InputReadInt4
    62) #endif
    63)   end interface
    64)   
    65)   interface InputReadDouble
    66)     module procedure InputReadDouble1
    67)     module procedure InputReadDouble2
    68)   end interface
    69)   
    70)   interface InputReadNDoubles
    71)     module procedure InputReadNDoubles1
    72)     module procedure InputReadNDoubles2
    73)   end interface
    74)   
    75)   interface InputError
    76)     module procedure InputError1
    77)     module procedure InputError2
    78)   end interface
    79)   
    80)   interface InputErrorMsg
    81)     module procedure InputErrorMsg1
    82)     module procedure InputErrorMsg2
    83)   end interface
    84)   
    85)   interface InputDefaultMsg
    86)     module procedure InputDefaultMsg1
    87)     module procedure InputDefaultMsg2
    88)   end interface
    89)   
    90)   interface InputReadStringErrorMsg
    91)     module procedure InputReadStringErrorMsg1
    92)     module procedure InputReadStringErrorMsg2
    93)   end interface
    94)   
    95)   interface InputFindStringInFile
    96)     module procedure InputFindStringInFile1
    97)     module procedure InputFindStringInFile2
    98)   end interface
    99) 
   100)   interface InputKeywordUnrecognized
   101)     module procedure InputKeywordUnrecognized1
   102)     module procedure InputKeywordUnrecognized2
   103)   end interface
   104)   
   105)   public :: InputCreate, InputDestroy, InputReadPflotranString, &
   106)             InputReadWord, InputReadDouble, InputReadInt, InputCheckExit, &
   107)             InputReadNDoubles, &
   108)             InputSkipToEND, InputFindStringInFile, InputErrorMsg, &
   109)             InputDefaultMsg, InputReadStringErrorMsg, &
   110)             InputFindStringErrorMsg, InputError, &
   111)             InputReadNChars, InputReadQuotedWord, &
   112)             InputReadPath, &
   113)             InputGetCommandLineInt, &
   114)             InputGetCommandLineReal, &
   115)             InputGetCommandLineTruth, &
   116)             InputGetCommandLineString, &
   117)             InputReadFilenames, &
   118)             InputGetLineCount, &
   119)             InputReadToBuffer, &
   120)             InputReadASCIIDbase, &
   121)             InputKeywordUnrecognized, &
   122)             InputCheckMandatoryUnits, &
   123)             InputDbaseDestroy, &
   124)             InputPushExternalFile, &
   125)             InputReadWordDbaseCompatible, &
   126)             InputReadAndConvertUnits
   127) 
   128) contains
   129) 
   130) ! ************************************************************************** !
   131) 
   132) function InputCreate(fid,filename,option)
   133)   ! 
   134)   ! Allocates and initializes a new Input object
   135)   ! 
   136)   ! Author: Glenn Hammond
   137)   ! Date: 11/10/08
   138)   ! 
   139) 
   140)   use Option_module
   141) 
   142)   implicit none
   143)   
   144)   PetscInt :: fid
   145)   character(len=*) :: filename
   146)   type(option_type) :: option
   147)   
   148)   type(input_type), pointer :: InputCreate
   149)   PetscInt :: status  
   150)   type(input_type), pointer :: input
   151)   
   152)   allocate(input)
   153) 
   154)   input%fid = fid
   155)   input%filename = filename
   156)   input%ierr = 0
   157)   input%buf = ''
   158)   input%err_buf = ''
   159)   input%err_buf2 = ''
   160)   input%broadcast_read = PETSC_FALSE
   161)   input%force_units = PETSC_FALSE
   162)   nullify(input%parent)
   163)   
   164)   if (fid == MAX_IN_UNIT) then
   165)     option%io_buffer = 'MAX_IN_UNIT in pflotran_constants.h must be increased to' // &
   166)       ' accommodate a larger number of embedded files.'
   167)     call printErrMsg(option)
   168)   endif
   169) 
   170)   open(unit=input%fid,file=filename,status="old",iostat=status)
   171)   if (status /= 0) then
   172)     if (len_trim(filename) == 0) filename = '<blank>'
   173)     option%io_buffer = 'File: "' // trim(filename) // '" not found.'
   174)     call printErrMsg(option)
   175)   endif
   176)   
   177)   InputCreate => input
   178)   
   179) end function InputCreate
   180) 
   181) ! ************************************************************************** !
   182) 
   183) subroutine InputDefaultMsg1(input,option,buffer)
   184)   ! 
   185)   ! If ierr /= 0, informs user that default value will be used.
   186)   ! 
   187)   ! Author: Glenn Hammond
   188)   ! Date: 11/10/08
   189)   ! 
   190) 
   191)   implicit none
   192) 
   193)   type(input_type) :: input
   194)   type(option_type) :: option
   195)   character(len=*) :: buffer
   196) 
   197)   if (InputError(input)) then
   198)     input%err_buf = buffer
   199)     call InputDefaultMsg(input,option)
   200)   endif
   201) 
   202) end subroutine InputDefaultMsg1
   203) 
   204) ! ************************************************************************** !
   205) 
   206) subroutine InputDefaultMsg2(input,option)
   207)   ! 
   208)   ! If ierr /= 0, informs user that default value will be used.
   209)   ! 
   210)   ! Author: Glenn Hammond
   211)   ! Date: 11/10/08
   212)   ! 
   213) 
   214)   implicit none
   215) 
   216)   type(input_type) :: input
   217)   type(option_type) :: option
   218) 
   219)   if (InputError(input)) then
   220)     option%io_buffer =  '"' // trim(input%err_buf) // &
   221)                         '" set to default value.'
   222)     call printMsg(option)
   223)     input%ierr = 0
   224)   endif
   225) 
   226) end subroutine InputDefaultMsg2
   227) 
   228) ! ************************************************************************** !
   229) 
   230) subroutine InputErrorMsg1(input,option,buffer1,buffer2)
   231)   ! 
   232)   ! If ierr /= 0, If ierr /= 0, informs user of error and stops.
   233)   ! 
   234)   ! Author: Glenn Hammond
   235)   ! Date: 11/10/08
   236)   ! 
   237) 
   238)   implicit none
   239) 
   240)   type(input_type) :: input
   241)   type(option_type) :: option
   242)   character(len=*) :: buffer1, buffer2
   243) 
   244)   if (InputError(input)) then
   245)     input%err_buf = buffer1
   246)     input%err_buf2 = buffer2
   247)     call InputErrorMsg(input,option)
   248)   endif
   249) 
   250) end subroutine InputErrorMsg1
   251) 
   252) ! ************************************************************************** !
   253) 
   254) subroutine InputErrorMsg2(input,option)
   255)   ! 
   256)   ! InputErrorMsg: If ierr /= 0, If ierr /= 0, informs user of error and stops.
   257)   ! 
   258)   ! Author: Glenn Hammond
   259)   ! Date: 11/10/08
   260)   ! 
   261) 
   262)   implicit none
   263) 
   264)   type(input_type) :: input
   265)   type(option_type) :: option
   266) 
   267)   if (InputError(input)) then
   268)     option%io_buffer = 'While reading "' // trim(input%err_buf) // &
   269)                        '" under keyword: ' // trim(input%err_buf2) // '.'
   270)     call printErrMsg(option)
   271)   endif
   272) 
   273) end subroutine InputErrorMsg2
   274) 
   275) ! ************************************************************************** !
   276) 
   277) subroutine InputReadStringErrorMsg1(input, option, buffer)
   278)   ! 
   279)   ! If ierr /= 0, informs user of error and stops.
   280)   ! 
   281)   ! Author: Glenn Hammond
   282)   ! Date: 11/10/08
   283)   ! 
   284) 
   285)   implicit none
   286) 
   287)   type(input_type) :: input
   288)   type(option_type) :: option
   289)   character(len=*) :: buffer
   290) 
   291)   if (InputError(input)) then
   292)     input%err_buf = buffer
   293)     call InputReadStringErrorMsg(input, option)
   294)   endif
   295) 
   296) end subroutine InputReadStringErrorMsg1
   297) 
   298) ! ************************************************************************** !
   299) 
   300) subroutine InputReadStringErrorMsg2(input, option)
   301)   ! 
   302)   ! If ierr /= 0, informs user of error and stops.
   303)   ! 
   304)   ! Author: Glenn Hammond
   305)   ! Date: 11/10/08
   306)   ! 
   307) 
   308)   implicit none
   309) 
   310)   type(input_type) :: input
   311)   type(option_type) :: option
   312) 
   313)   if (InputError(input)) then
   314)     option%io_buffer = 'While reading in string in "' // &
   315)                        trim(input%err_buf) // '".'
   316)     call printErrMsg(option)
   317)   endif
   318) 
   319) end subroutine InputReadStringErrorMsg2
   320) 
   321) ! ************************************************************************** !
   322) 
   323) subroutine InputFindStringErrorMsg(input, option, string)
   324)   ! 
   325)   ! If ierr /= 0, informs user of error and stops.
   326)   ! 
   327)   ! Author: Glenn Hammond
   328)   ! Date: 11/10/08
   329)   ! 
   330) 
   331)   implicit none
   332) 
   333)   type(input_type) :: input
   334)   type(option_type) :: option
   335)   character(len=*) :: string
   336) 
   337)   if (InputError(input)) then
   338)     option%io_buffer = 'Card (' // trim(string) // ') not &
   339)                        &found in file.'
   340)     call printErrMsg(option)    
   341)   endif
   342) 
   343) end subroutine InputFindStringErrorMsg
   344) 
   345) ! ************************************************************************** !
   346) 
   347) subroutine InputReadInt1(input, option, int)
   348)   ! 
   349)   ! reads and removes an integer value from a string
   350)   ! 
   351)   ! Author: Glenn Hammond
   352)   ! Date: 11/10/08
   353)   ! 
   354) 
   355)   implicit none
   356) 
   357)   type(input_type) :: input
   358)   type(option_type) :: option
   359)   PetscInt :: int
   360) 
   361)   character(len=MAXWORDLENGTH) :: word
   362)   PetscBool :: found
   363) 
   364)   found = PETSC_FALSE
   365)   if (associated(dbase)) then
   366)     call InputParseDbaseForInt(input%buf,int,found,input%ierr)
   367)   endif
   368)   
   369)   if (.not.found) then
   370)     call InputReadWord(input%buf,word,PETSC_TRUE,input%ierr)
   371)   
   372)     if (.not.InputError(input)) then
   373)       read(word,*,iostat=input%ierr) int
   374)     endif
   375)   endif
   376) 
   377) end subroutine InputReadInt1
   378) 
   379) ! ************************************************************************** !
   380) 
   381) subroutine InputReadInt2(string, option, int, ierr)
   382)   ! 
   383)   ! reads and removes an integer value from a string
   384)   ! 
   385)   ! Author: Glenn Hammond
   386)   ! Date: 11/10/08
   387)   ! 
   388) 
   389)   implicit none
   390) 
   391)   character(len=MAXSTRINGLENGTH) :: string
   392)   type(option_type) :: option
   393)   PetscInt :: int
   394)   PetscErrorCode :: ierr
   395) 
   396)   character(len=MAXWORDLENGTH) :: word
   397)   PetscBool :: found
   398) 
   399)   ierr = 0
   400) 
   401)   found = PETSC_FALSE
   402)   if (associated(dbase)) then
   403)     call InputParseDbaseForInt(string,int,found,ierr)
   404)   endif
   405)   
   406)   if (.not.found) then
   407)     call InputReadWord(string,word,PETSC_TRUE,ierr)
   408)   
   409)     if (.not.InputError(ierr)) then
   410)       read(word,*,iostat=ierr) int
   411)     endif
   412)   endif
   413) 
   414) end subroutine InputReadInt2
   415) 
   416) #if defined(PETSC_USE_64BIT_INDICES) && (PETSC_SIZEOF_MPI_FINT * PETSC_BITS_PER_BYTE != 64)
   417) 
   418) ! ************************************************************************** !
   419) 
   420) subroutine InputReadInt3(input, option, int)
   421)   ! 
   422)   ! InputReadInt3() and InputReadInt4() must only be defined if PetscInt and
   423)   ! PetscMPIInt differ in size.  See notes above in the interface definition.
   424)   ! --RTM
   425)   ! reads and removes an integer value from a string
   426)   ! authors: Glenn Hammond, Richard Mills
   427)   ! 
   428)   ! Date: 2/3/2012
   429)   ! 
   430) 
   431)   implicit none
   432) 
   433)   type(input_type) :: input
   434)   type(option_type) :: option
   435)   PetscMPIInt :: int
   436) 
   437)   character(len=MAXWORDLENGTH) :: word
   438) 
   439)   call InputReadWord(input%buf,word,PETSC_TRUE,input%ierr)
   440)   
   441)   if (.not.InputError(input)) then
   442)     read(word,*,iostat=input%ierr) int
   443)   endif
   444) 
   445) end subroutine InputReadInt3
   446) 
   447) ! ************************************************************************** !
   448) 
   449) subroutine InputReadInt4(string, option, int, ierr)
   450)   ! 
   451)   ! reads and removes an integer value from a string
   452)   ! authors: Glenn Hammond, Richard Mills
   453)   ! 
   454)   ! Date: 2/3/2012
   455)   ! 
   456) 
   457)   implicit none
   458) 
   459)   character(len=MAXSTRINGLENGTH) :: string
   460)   type(option_type) :: option
   461)   PetscMPIInt :: int
   462)   PetscErrorCode :: ierr
   463) 
   464)   character(len=MAXWORDLENGTH) :: word
   465) 
   466)   ierr = 0
   467)   call InputReadWord(string,word,PETSC_TRUE,ierr)
   468)   
   469)   if (.not.InputError(ierr)) then
   470)     read(word,*,iostat=ierr) int
   471)   endif
   472) 
   473) end subroutine InputReadInt4
   474) 
   475) #endif
   476) ! End of defined(PETSC_USE_64BIT_INDICES) &&
   477) ! (PETSC_SIZEOF_MPI_FINT * PETSC_BITS_PER_BYTE != 64) conditional
   478) 
   479) ! ************************************************************************** !
   480) 
   481) subroutine InputReadDouble1(input, option, double)
   482)   ! 
   483)   ! reads and removes a real value from a string
   484)   ! 
   485)   ! Author: Glenn Hammond
   486)   ! Date: 11/10/08
   487)   ! 
   488) 
   489)   implicit none
   490) 
   491)   type(input_type) :: input
   492)   type(option_type) :: option
   493)   PetscReal :: double
   494) 
   495)   character(len=MAXWORDLENGTH) :: word
   496)   PetscBool :: found
   497) 
   498)   found = PETSC_FALSE
   499)   if (associated(dbase)) then
   500)     call InputParseDbaseForDouble(input%buf,double,found,input%ierr)
   501)   endif
   502)   
   503)   if (.not.found) then
   504)     call InputReadWord(input%buf,word,PETSC_TRUE,input%ierr)
   505)   
   506)     if (.not.InputError(input)) then
   507)       read(word,*,iostat=input%ierr) double
   508)     endif
   509)   endif
   510) 
   511) end subroutine InputReadDouble1
   512) 
   513) ! ************************************************************************** !
   514) 
   515) subroutine InputReadDouble2(string, option, double, ierr)
   516)   ! 
   517)   ! reads and removes a real value from a string
   518)   ! 
   519)   ! Author: Glenn Hammond
   520)   ! Date: 11/10/08
   521)   ! 
   522) 
   523)   implicit none
   524) 
   525)   character(len=MAXSTRINGLENGTH) :: string
   526)   type(option_type) :: option
   527)   PetscReal :: double
   528)   PetscErrorCode :: ierr
   529) 
   530)   character(len=MAXWORDLENGTH) :: word
   531)   PetscBool :: found
   532) 
   533)   ierr = 0
   534)   
   535)   found = PETSC_FALSE
   536)   if (associated(dbase)) then
   537)     call InputParseDbaseForDouble(string,double,found,ierr)
   538)   endif
   539)   
   540)   if (.not.found) then
   541)     call InputReadWord(string,word,PETSC_TRUE,ierr)
   542)   
   543)     if (.not.InputError(ierr)) then
   544)       read(word,*,iostat=ierr) double
   545)     endif
   546)   endif
   547) 
   548) end subroutine InputReadDouble2
   549) 
   550) ! ************************************************************************** !
   551) 
   552) subroutine InputReadNDoubles1(input, option, double, n)
   553)   ! 
   554)   ! reads and removes "n" real value from a string
   555)   ! 
   556)   ! Author: Glenn Hammond
   557)   ! Date: 08/29/11
   558)   ! 
   559) 
   560)   implicit none
   561) 
   562)   type(input_type) :: input
   563)   type(option_type) :: option
   564)   PetscInt :: n
   565)   PetscReal :: double(n)
   566) 
   567)   PetscInt :: i
   568) 
   569)   do i = 1, n
   570)     call InputReadDouble(input,option,double(i))
   571)     if (InputError(input)) return
   572)   enddo
   573) 
   574) end subroutine InputReadNDoubles1
   575) 
   576) ! ************************************************************************** !
   577) 
   578) subroutine InputReadNDoubles2(string, option, double, n, ierr)
   579)   ! 
   580)   ! reads and removes "n" real values from a string
   581)   ! 
   582)   ! Author: Glenn Hammond
   583)   ! Date: 08/29/11
   584)   ! 
   585) 
   586)   implicit none
   587) 
   588)   character(len=MAXSTRINGLENGTH) :: string
   589)   type(option_type) :: option
   590)   PetscInt :: n
   591)   PetscReal :: double(n)
   592)   PetscErrorCode :: ierr
   593) 
   594)   PetscInt :: i
   595) 
   596)   do i = 1, n
   597)     call InputReadDouble(string,option,double(i),ierr)
   598)     if (InputError(ierr)) return
   599)   enddo
   600) 
   601) end subroutine InputReadNDoubles2
   602) 
   603) ! ************************************************************************** !
   604) 
   605) subroutine InputReadPflotranString(input, option)
   606)   ! 
   607)   ! Reads a string (strlen characters long) from a
   608)   ! file while avoiding commented or skipped lines.
   609)   ! 
   610)   ! Author: Glenn Hammond
   611)   ! Date: 11/10/08
   612)   ! 
   613) 
   614)   implicit none
   615) 
   616)   type(input_type), pointer :: input
   617)   type(option_type) :: option
   618)   
   619)   PetscErrorCode :: ierr
   620)   PetscInt :: flag
   621) 
   622)   if (input%broadcast_read) then
   623)     if (option%myrank == option%io_rank) then
   624)       call InputReadPflotranStringSlave(input, option)
   625)     endif
   626)     flag = input%ierr
   627)     call MPI_Bcast(flag,ONE_INTEGER_MPI,MPIU_INTEGER,option%io_rank, &
   628)                    option%mycomm,ierr)
   629)     input%ierr = flag
   630)     if (.not.InputError(input)) then  
   631)       call MPI_Bcast(input%buf,MAXSTRINGLENGTH,MPI_CHARACTER, &
   632)                      option%io_rank,option%mycomm,ierr)      
   633)     endif
   634)   else
   635)     call InputReadPflotranStringSlave(input, option)
   636)   endif
   637) 
   638) end subroutine InputReadPflotranString
   639) 
   640) ! ************************************************************************** !
   641) 
   642) subroutine InputReadPflotranStringSlave(input, option)
   643)   ! 
   644)   ! Reads a string (strlen characters long) from a
   645)   ! file while avoiding commented or skipped lines.
   646)   ! 
   647)   ! Author: Glenn Hammond
   648)   ! Date: 11/10/08
   649)   ! 
   650) 
   651)   use String_module
   652)   
   653)   implicit none
   654) 
   655)   type(input_type), pointer :: input
   656)   type(option_type) :: option
   657)   character(len=MAXSTRINGLENGTH) ::  tempstring
   658)   character(len=MAXWORDLENGTH) :: word
   659)   PetscInt :: i
   660)   PetscInt :: skip_count
   661) 
   662)   input%ierr = 0
   663) 
   664) ! we initialize the word to blanks to avoid error reported by valgrind
   665) !  do i=1,MAXWORDLENGTH
   666) !     word(i:i) = ' '
   667) !  enddo
   668)   word = ''
   669)   
   670)   do
   671)     read(input%fid,'(a512)',iostat=input%ierr) input%buf
   672)     call StringAdjustl(input%buf)
   673) 
   674)     if (InputError(input)) then
   675)       ! check to see if another file is on the stack
   676)       if (InputPopExternalFile(input)) then
   677)         cycle
   678)       else
   679)         exit
   680)       endif
   681)     endif
   682) 
   683)     if (input%buf(1:1) == '#' .or. input%buf(1:1) == '!') cycle
   684) 
   685)     tempstring = input%buf
   686)     call InputReadWord(tempstring,word,PETSC_TRUE,input%ierr)
   687)     call StringToUpper(word)
   688)     
   689)     if (word(1:13) == 'EXTERNAL_FILE') then
   690)       ! have to stip the card 'EXTERNAL_FILE' from the buffer
   691)       call InputReadWord(input,option,word,PETSC_TRUE)
   692)       ! push a new input file to stack
   693)       call InputPushExternalFile(input,option)
   694)       cycle
   695)     else if (word(1:4) == 'SKIP') then
   696)       skip_count = 1
   697)       do 
   698)         read(input%fid,'(a512)',iostat=input%ierr) tempstring
   699)         if (InputError(input)) then
   700)           option%io_buffer = 'End of file reached in ' // &
   701)               'InputReadPflotranStringSlave.  SKIP encountered ' // &
   702)               'without a matching NOSKIP.'
   703)           call printErrMsg(option)              
   704)         endif
   705)         call InputReadWord(tempstring,word,PETSC_FALSE,input%ierr)
   706)         call StringToUpper(word)
   707)         if (word(1:4) == 'SKIP') skip_count = skip_count + 1
   708)         if (word(1:4) == 'NOSK') then
   709)           skip_count = skip_count - 1
   710)           if (skip_count == 0) exit
   711)         endif
   712)       enddo
   713)       if (InputError(input)) exit
   714)     else if (word(1:1) /= ' ' .and. word(1:4) /= 'NOSK') then
   715)       exit
   716)     endif
   717)   enddo
   718)   
   719)   ! Check for comment midway along a string
   720)   if (.not.InputError(input)) then
   721)     tempstring = input%buf
   722)     input%buf = repeat(' ',MAXSTRINGLENGTH)
   723)     do i=1,len_trim(tempstring)
   724)       if (tempstring(i:i) /= '#' .and. tempstring(i:i) /= '!') then
   725)         input%buf(i:i) = tempstring(i:i)
   726)       else
   727)         exit
   728)       endif
   729)     enddo
   730)   endif
   731) 
   732) end subroutine InputReadPflotranStringSlave
   733) 
   734) ! ************************************************************************** !
   735) 
   736) subroutine InputReadWord1(input, option, word, return_blank_error)
   737)   ! 
   738)   ! reads and removes a word (consecutive characters) from a string
   739)   ! 
   740)   ! Author: Glenn Hammond
   741)   ! Date: 11/10/08
   742)   ! 
   743) 
   744)   implicit none
   745) 
   746)   type(input_type) :: input
   747)   type(option_type) :: option
   748)   character(len=MAXWORDLENGTH) :: word
   749)   PetscBool :: return_blank_error
   750)   
   751)   if (InputError(input)) return
   752)   
   753)   call InputReadWord2(input%buf, word, return_blank_error, input%ierr)
   754) 
   755) end subroutine InputReadWord1
   756) 
   757) ! ************************************************************************** !
   758) 
   759) subroutine InputReadWord2(string, word, return_blank_error, ierr)
   760)   ! 
   761)   ! reads and removes a word (consecutive characters) from a
   762)   ! string
   763)   ! 
   764)   ! Author: Glenn Hammond
   765)   ! Date: 11/10/08
   766)   ! 
   767) 
   768)   implicit none
   769) 
   770)   character(len=*) :: string
   771)   character(len=*) :: word
   772)   PetscBool :: return_blank_error
   773)   PetscErrorCode :: ierr
   774)   
   775)   PetscInt :: i, begins, ends, length
   776)   character(len=1), parameter :: tab = achar(9), backslash = achar(92)
   777) 
   778)   if (ierr /= 0) return
   779) 
   780)   ! Initialize character string to blank.
   781)   ! Initialize character string to blank.  len_trim(word) is not
   782)   ! defined if word is allocated but not initialized.  This works on
   783)   ! most compilers, but may not work on some?  Holler if it
   784)   ! errors... - etc
   785)   word = ''
   786)   ! do i=1,len_trim(word)
   787)   !   word(i:i) = ' '
   788)   ! enddo
   789) 
   790)   length = len_trim(string)
   791)   
   792)   if (length == 0) then
   793)     if (return_blank_error) then
   794)       ierr = 1
   795)     else
   796)       ierr = 0
   797)     endif
   798)     return
   799)   else
   800)     ierr = 0
   801) 
   802)     ! Remove leading blanks and tabs
   803)     i=1
   804)     do while((string(i:i) == ' ' .or. string(i:i) == ',' .or. &
   805)              string(i:i) == tab) .and. i <= length) 
   806)       i=i+1
   807)     enddo
   808) 
   809)     if (i > length) then
   810)       if (return_blank_error) then
   811)         ierr = 1
   812)       else
   813)         ierr = 0
   814)       endif
   815)       return
   816)     endif
   817)     
   818)     begins=i
   819) 
   820)     ! Count # of continuous characters (no blanks, commas, etc. in between)
   821)     do while (string(i:i) /= ' ' .and. string(i:i) /= ',' .and. &
   822)               string(i:i) /= tab .and. &
   823)               (i == begins .or. string(i:i) /= backslash))
   824)       i=i+1
   825)     enddo
   826) 
   827)     ends=i-1
   828) 
   829)     ! Avoid copying beyond the end of the word (32 characters).
   830)     if (ends-begins > (MAXWORDLENGTH-1)) ends = begins + (MAXWORDLENGTH-1)
   831) 
   832)     ! Copy (ends-begins) characters to 'word'
   833)     word = string(begins:ends)
   834)     ! Remove chars from string
   835)     string = string(ends+1:)
   836) 
   837)   endif
   838) 
   839) end subroutine InputReadWord2
   840) 
   841) ! ************************************************************************** !
   842) 
   843) subroutine InputReadWordDbaseCompatible(input, option, word, &
   844)                                         return_blank_error)
   845)   ! 
   846)   ! reads a word and checks whether there is an entry in the Dbase with which
   847)   ! to swap
   848)   ! 
   849)   ! Author: Glenn Hammond
   850)   ! Date: 05/22/16
   851)   ! 
   852) 
   853)   implicit none
   854) 
   855)   type(input_type) :: input
   856)   type(option_type) :: option
   857)   character(len=MAXWORDLENGTH) :: word
   858)   PetscBool :: return_blank_error
   859)   
   860)   PetscBool :: found
   861) 
   862)   if (InputError(input)) return
   863) 
   864)   found = PETSC_FALSE
   865)   if (associated(dbase)) then
   866)     call InputParseDbaseForWord(input%buf,word,found,input%ierr)
   867)   endif
   868)   
   869)   if (.not.found) then
   870)     call InputReadWord(input%buf,word,PETSC_TRUE,input%ierr)
   871)   endif
   872) 
   873) end subroutine InputReadWordDbaseCompatible
   874) 
   875) ! ************************************************************************** !
   876) 
   877) subroutine InputReadNChars1(input, option, chars, n, return_blank_error)
   878)   ! 
   879)   ! reads and removes a specified number of characters from a
   880)   ! string
   881)   ! 
   882)   ! Author: Glenn Hammond
   883)   ! Date: 11/02/00
   884)   ! 
   885) 
   886)   implicit none
   887) 
   888)   type(input_type) :: input
   889)   type(option_type) :: option
   890)   PetscBool :: return_blank_error ! Return an error for a blank line
   891)                                    ! Therefore, a blank line is not acceptable.
   892)   
   893)   PetscInt :: i, n, begins, ends
   894)   character(len=n) :: chars
   895)   character(len=1) :: tab, backslash    
   896) 
   897)   if (InputError(input)) return
   898) 
   899)   call InputReadNChars2(input%buf, chars, n, return_blank_error, input%ierr)
   900)   
   901) end subroutine InputReadNChars1
   902) 
   903) ! ************************************************************************** !
   904) 
   905) subroutine InputReadNChars2(string, chars, n, return_blank_error, ierr)
   906)   ! 
   907)   ! reads and removes a specified number of characters from a
   908)   ! string
   909)   ! 
   910)   ! Author: Glenn Hammond
   911)   ! Date: 11/02/00
   912)   ! 
   913) 
   914)   implicit none
   915) 
   916)   character(len=MAXSTRINGLENGTH) :: string
   917)   PetscBool :: return_blank_error ! Return an error for a blank line
   918)                                    ! Therefore, a blank line is not acceptable.
   919)   
   920)   PetscInt :: i, n, begins, ends
   921)   character(len=n) :: chars
   922)   PetscErrorCode :: ierr
   923)   character(len=1), parameter :: tab = achar(9), backslash = achar(92)
   924) 
   925)   if (InputError(ierr)) return
   926) 
   927)   ! Initialize character string to blank.
   928)   chars(1:n) = repeat(' ',n)
   929) 
   930)   ierr = len_trim(string)
   931)   if (.not.InputError(ierr)) then
   932)     if (return_blank_error) then
   933)       ierr = 1
   934)     else
   935)       ierr = 0
   936)     endif
   937)     return
   938)   else
   939)     ierr = 0
   940) 
   941)     ! Remove leading blanks and tabs
   942)     i=1
   943)     do while(string(i:i) == ' ' .or. string(i:i) == tab) 
   944)       i=i+1
   945)     enddo
   946) 
   947)     begins=i
   948) 
   949)     ! Count # of continuous characters (no blanks, commas, etc. in between)
   950)     do while (string(i:i) /= ' ' .and. string(i:i) /= ',' .and. &
   951)               string(i:i) /= tab  .and. &
   952)               (i == begins .or. string(i:i) /= backslash))
   953)       i=i+1
   954)     enddo
   955) 
   956)     ends=i-1
   957) 
   958)     if (ends-begins+1 > n) then ! string read is too large for 'chars'
   959)       ierr = 1
   960)       return
   961)     endif
   962) 
   963)     ! Copy (ends-begins) characters to 'chars'
   964)     chars = string(begins:ends)
   965)     ! Remove chars from string
   966)     string = string(ends+1:)
   967) 
   968)   endif
   969) 
   970) end subroutine InputReadNChars2
   971) 
   972) ! ************************************************************************** !
   973) 
   974) subroutine InputReadQuotedWord(input, option, word, return_blank_error)
   975)   ! 
   976)   ! reads and removes a word from a string, that is
   977)   ! delimited by "'".
   978)   ! 
   979)   ! Author: Glenn Hammond
   980)   ! Date: 11/07/00
   981)   ! 
   982) 
   983)   implicit none
   984) 
   985)   type(input_type) :: input
   986)   type(option_type) :: option
   987)   PetscInt :: i, begins, ends, realends, len_trim_word
   988)   PetscBool :: return_blank_error ! Return an error for a blank line
   989)                                 ! Therefore, a blank line is not acceptable.
   990)   character(len=*) :: word
   991)   PetscBool :: openquotefound
   992)   character(len=1), parameter :: tab = achar(9), backslash = achar(92)
   993) 
   994)   if (InputError(input)) return
   995) 
   996)   openquotefound = PETSC_FALSE
   997)   ! Initialize character string to blank.
   998)   len_trim_word = len_trim(word)
   999)   word(1:len_trim_word) = repeat(' ',len_trim_word)
  1000)   
  1001)   if (len_trim(input%buf) == 0) then
  1002)     if (return_blank_error) then
  1003)       input%ierr = 1
  1004)     else
  1005)       input%ierr = 0
  1006)     endif
  1007)     return
  1008)   else
  1009)     input%ierr = 0  
  1010)     
  1011)     ! Remove leading blanks and tabs
  1012)     i=1
  1013)     do while(input%buf(i:i) == ' ' .or. input%buf(i:i) == tab) 
  1014)       i=i+1
  1015)     enddo
  1016) 
  1017)     if (input%buf(i:i) == "'") then
  1018)       openquotefound = PETSC_TRUE
  1019)       i=i+1
  1020)     endif
  1021) 
  1022)     begins=i
  1023) 
  1024)     if (openquotefound) then
  1025)       do while (input%buf(i:i) /= "'")
  1026)         if (i > (MAXWORDLENGTH-1)) exit
  1027)         i=i+1
  1028)       enddo
  1029)     else
  1030)     ! Count # of continuous characters (no blanks, commas, etc. in between)
  1031)       do while (input%buf(i:i) /= ' ' .and. input%buf(i:i) /= ',' .and. &
  1032)                 input%buf(i:i) /= tab .and. &
  1033)                 (i == begins .or. input%buf(i:i) /= backslash))
  1034)         i=i+1
  1035)       enddo
  1036)     endif
  1037) 
  1038)     realends = i
  1039)     ends=i-1
  1040) 
  1041)     ! Avoid copying beyond the end of the word (32 characters).
  1042)     if (ends-begins > (MAXWORDLENGTH-1)) ends = begins + (MAXWORDLENGTH-1)
  1043) 
  1044)     ! Copy (ends-begins) characters to 'chars'
  1045)     word = input%buf(begins:ends)
  1046)     ! Remove chars from string
  1047)     input%buf = input%buf(realends+1:)
  1048)   endif
  1049) 
  1050) end subroutine InputReadQuotedWord
  1051) 
  1052) ! ************************************************************************** !
  1053) 
  1054) subroutine InputReadPath(string, word, return_blank_error, ierr)
  1055)   ! 
  1056)   ! reads and removes a words from a path
  1057)   ! 
  1058)   ! Author: Glenn Hammond
  1059)   ! Date: 01/14/10
  1060)   ! 
  1061) 
  1062)   implicit none
  1063) 
  1064)   character(len=*) :: string
  1065)   character(len=*) :: word
  1066)   PetscBool :: return_blank_error
  1067)   PetscErrorCode :: ierr
  1068)   
  1069)   PetscInt :: i, begins, ends, len_trim_word
  1070)   character(len=1), parameter :: slash = achar(47), backslash = achar(92)
  1071) 
  1072)   if (ierr /= 0) return
  1073) 
  1074)   ! Initialize character string to blank.
  1075)   len_trim_word = len_trim(word)
  1076)   word(1:len_trim_word) = repeat(' ',len_trim_word)
  1077) 
  1078)   ierr = len_trim(string)
  1079)   
  1080)   if (ierr == 0) then
  1081)     if (return_blank_error) then
  1082)       ierr = 1
  1083)     else
  1084)       ierr = 0
  1085)     endif
  1086)     return
  1087)   else
  1088)     ierr = 0
  1089) 
  1090)     ! Remove leading blanks and tabs
  1091)     i=1
  1092)     do while(string(i:i) == ' ' .and. string(i:i) == slash) 
  1093)       i=i+1
  1094)     enddo
  1095) 
  1096)     begins=i
  1097) 
  1098)     ! Count # of characters (no slashes in between)
  1099)     do while (string(i:i) /= slash .and. &
  1100)               (i == begins .or. string(i:i) /= backslash))
  1101)       i=i+1
  1102)     enddo
  1103) 
  1104)     ends=i-1
  1105) 
  1106)     ! Avoid copying beyond the end of the word (32 characters).
  1107)     if (ends-begins > (MAXWORDLENGTH-1)) ends = begins + (MAXWORDLENGTH-1)
  1108) 
  1109)     ! Copy (ends-begins) characters to 'word'
  1110)     word = string(begins:ends)
  1111)     ! Remove chars from string
  1112)     string = string(ends+1:)
  1113) 
  1114)   endif
  1115)   
  1116) end subroutine InputReadPath
  1117) 
  1118) ! ************************************************************************** !
  1119) 
  1120) subroutine InputFindStringInFile1(input, option, string)
  1121)   ! 
  1122)   ! Rewinds file and finds the first occurrence of
  1123)   ! 'string'.  Note that the line must start with 'string'
  1124)   ! in order to match and that line is NOT returned
  1125)   ! 
  1126)   ! Author: Glenn Hammond
  1127)   ! Date: 03/07/07
  1128)   ! 
  1129) 
  1130)   use String_module
  1131) 
  1132)   implicit none
  1133) 
  1134)   type(input_type), pointer :: input
  1135)   type(option_type) :: option
  1136)   character(len=MAXSTRINGLENGTH) :: string
  1137)   
  1138)   call InputFindStringInFile2(input, option, string, PETSC_TRUE)
  1139)   
  1140) end subroutine InputFindStringInFile1
  1141) 
  1142) ! ************************************************************************** !
  1143) 
  1144) subroutine InputFindStringInFile2(input, option, string, print_warning)
  1145)   ! 
  1146)   ! Rewinds file and finds the first occurrence of
  1147)   ! 'string'.  Note that the line must start with 'string'
  1148)   ! in order to match and that line is NOT returned
  1149)   ! 
  1150)   ! Author: Glenn Hammond
  1151)   ! Date: 03/07/07
  1152)   ! 
  1153) 
  1154)   use String_module
  1155) 
  1156)   implicit none
  1157) 
  1158)   type(input_type), pointer :: input
  1159)   type(option_type) :: option
  1160)   character(len=MAXSTRINGLENGTH) :: string
  1161)   PetscBool :: print_warning
  1162)   
  1163)   character(len=MAXWORDLENGTH) :: word
  1164)   PetscBool :: found = PETSC_FALSE
  1165)   PetscInt :: length1, length2, i
  1166) 
  1167)   input%ierr = 0
  1168) 
  1169)   length1 = len_trim(string)
  1170) 
  1171)   do 
  1172)     call InputReadPflotranString(input,option)
  1173)     if (InputError(input)) exit
  1174)     call InputReadWord(input,option,word,PETSC_TRUE)
  1175)     if (InputError(input)) exit
  1176)     length2 = len_trim(word)
  1177)     if (length1 == length2 .and. StringCompare(string,word,length1)) then
  1178)       found = PETSC_TRUE
  1179)       exit
  1180)     endif
  1181)   enddo
  1182)   
  1183)   ! if not found, rewind once and try again.  this approach avoids excessive 
  1184)   ! reading if successive searches for strings are in descending order in 
  1185)   ! the file.
  1186)   if (InputError(input)) then
  1187)     input%ierr = 0
  1188)     rewind(input%fid)
  1189)     do 
  1190)       call InputReadPflotranString(input,option)
  1191)       if (InputError(input)) exit
  1192)       call InputReadWord(input,option,word,PETSC_TRUE)
  1193)       if (InputError(input)) exit
  1194)       length2 = len_trim(word)
  1195)       if (length1 == length2 .and. StringCompare(string,word,length1)) then
  1196)         found = PETSC_TRUE
  1197)         exit
  1198)       endif
  1199)     enddo
  1200)   endif    
  1201)   
  1202)   if (.not.found .and. print_warning) then
  1203)     option%io_buffer = 'Card (' // trim(string) // ') not found in input file.'
  1204)     call printWrnMsg(option)
  1205)     input%ierr = 1
  1206)   endif
  1207)   
  1208) end subroutine InputFindStringInFile2
  1209) 
  1210) ! ************************************************************************** !
  1211) 
  1212) subroutine InputSkipToEND(input,option,string)
  1213)   ! 
  1214)   ! Skips to keyword END
  1215)   ! 
  1216)   ! Author: Glenn Hammond
  1217)   ! Date: 10/26/07
  1218)   ! 
  1219) 
  1220)   implicit none
  1221)   
  1222)   type(input_type), pointer :: input
  1223)   type(option_type) :: option
  1224)   character(len=*) :: string
  1225) 
  1226)   do
  1227)     call InputReadPflotranString(input,option)
  1228)     input%err_buf = 'End of file found before end of card ' // trim(string)
  1229)     call InputReadStringErrorMsg(input,option)
  1230)     if (InputCheckExit(input,option)) exit
  1231)   enddo
  1232) 
  1233) end subroutine InputSkipToEND
  1234) 
  1235) ! ************************************************************************** !
  1236) 
  1237) function InputCheckExit(input,option)
  1238)   ! 
  1239)   ! Checks whether an end character (.,/,'END') has been found
  1240)   ! 
  1241)   ! Author: Glenn Hammond
  1242)   ! Date: 10/14/08
  1243)   ! 
  1244) 
  1245)   use String_module
  1246)   
  1247)   implicit none
  1248) 
  1249)   type(input_type) :: input
  1250)   type(option_type) :: option  
  1251)   PetscInt :: i
  1252)   character(len=1) :: tab
  1253)   
  1254)   PetscBool :: InputCheckExit
  1255) 
  1256)   ! We must remove leading blanks and tabs. --RTM
  1257)   tab = achar(9)
  1258)   i=1
  1259)   do while(input%buf(i:i) == ' ' .or. input%buf(i:i) == tab) 
  1260)     i=i+1
  1261)   enddo
  1262) 
  1263)   if (input%buf(i:i) == '/' .or. &
  1264) !geh: this fails when the keyword starts with END
  1265) !geh      StringCompare(input%buf(i:),'END',THREE_INTEGER)) then
  1266)       StringCompare(input%buf(i:),'END') .or. &
  1267)       ! to end a block, e.g. END_SUBSURFACE
  1268)       StringStartsWith(input%buf(i:),'END_')) then
  1269)     InputCheckExit = PETSC_TRUE
  1270)   else
  1271)     InputCheckExit = PETSC_FALSE
  1272)   endif
  1273) 
  1274) end function InputCheckExit
  1275) 
  1276) ! ************************************************************************** !
  1277) 
  1278) function InputError1(input)
  1279)   ! 
  1280)   ! Returns true if an error has occurred
  1281)   ! 
  1282)   ! Author: Glenn Hammond
  1283)   ! Date: 12/10/08
  1284)   ! 
  1285) 
  1286)   implicit none
  1287) 
  1288)   type(input_type) :: input
  1289)   
  1290)   PetscBool :: InputError1
  1291) 
  1292)   if (input%ierr == 0) then
  1293)     InputError1 = PETSC_FALSE
  1294)   else
  1295)     InputError1 = PETSC_TRUE
  1296)   endif
  1297) 
  1298) end function InputError1
  1299) 
  1300) ! ************************************************************************** !
  1301) 
  1302) function InputError2(ierr)
  1303)   ! 
  1304)   ! Returns true if an error has occurred
  1305)   ! 
  1306)   ! Author: Glenn Hammond
  1307)   ! Date: 12/10/08
  1308)   ! 
  1309) 
  1310)   implicit none
  1311) 
  1312)   PetscErrorCode :: ierr
  1313)   
  1314)   PetscBool :: InputError2
  1315) 
  1316)   if (ierr == 0) then
  1317)     InputError2 = PETSC_FALSE
  1318)   else
  1319)     InputError2 = PETSC_TRUE
  1320)   endif
  1321) 
  1322) end function InputError2
  1323) 
  1324) ! ************************************************************************** !
  1325) 
  1326) subroutine InputGetCommandLineInt(string,int_value,found,option)
  1327)   ! 
  1328)   ! Returns integer value associated with a command
  1329)   ! line argument
  1330)   ! 
  1331)   ! Author: Glenn Hammond
  1332)   ! Date: 02/05/09
  1333)   ! 
  1334) 
  1335)   use String_module
  1336)   use Option_module
  1337) 
  1338)   implicit none
  1339) 
  1340)   character(len=MAXSTRINGLENGTH) :: string
  1341)   type(option_type) :: option
  1342)   PetscBool :: found
  1343)   PetscInt :: int_value
  1344) 
  1345)   PetscInt :: iarg, narg
  1346)   character(len=MAXSTRINGLENGTH) :: string2
  1347)   PetscErrorCode :: ierr
  1348)   
  1349)   ierr = 0
  1350)   ! do not initialize int_value, as it may already have a value
  1351)   found = PETSC_FALSE
  1352)   narg = getCommandLineArgumentCount()
  1353)   string = adjustl(string)
  1354)   do iarg = 1, narg
  1355)     call getCommandLineArgument(iarg,string2)
  1356)     if (StringCompare(string,string2)) then
  1357)       found = PETSC_TRUE
  1358)       if (iarg+1 <= narg) then
  1359)         call getCommandLineArgument(iarg+1,string2)
  1360)         call InputReadInt(string2,option,int_value,ierr)
  1361)       else
  1362)         ierr = 1
  1363)       endif
  1364)       if (InputError(ierr)) then
  1365)         option%io_buffer = 'Integer argument for command line argument "' // &
  1366)                            trim(adjustl(string)) // '" not found.'
  1367)         call printErrMsg(option)
  1368)       endif
  1369)       exit
  1370)     endif
  1371)   enddo
  1372)   
  1373) end subroutine InputGetCommandLineInt
  1374) 
  1375) ! ************************************************************************** !
  1376) 
  1377) subroutine InputGetCommandLineReal(string,double_value,found,option)
  1378)   ! 
  1379)   ! Returns real*8 value associated with a command
  1380)   ! line argument
  1381)   ! 
  1382)   ! Author: Glenn Hammond
  1383)   ! Date: 02/05/09
  1384)   ! 
  1385) 
  1386)   use String_module
  1387)   use Option_module
  1388)   
  1389)   implicit none
  1390) 
  1391)   character(len=MAXSTRINGLENGTH) :: string
  1392)   type(option_type) :: option
  1393)   PetscBool :: found
  1394)   PetscReal :: double_value
  1395) 
  1396)   PetscInt :: iarg, narg
  1397)   character(len=MAXSTRINGLENGTH) :: string2
  1398)   PetscErrorCode :: ierr
  1399)   
  1400)   ierr = 0
  1401)   ! do not initialize int_value, as it may already have a value
  1402)   found = PETSC_FALSE
  1403)   narg = getCommandLineArgumentCount()
  1404)   string = adjustl(string)
  1405)   do iarg = 1, narg
  1406)     call getCommandLineArgument(iarg,string2)
  1407)     if (StringCompare(string,string2)) then
  1408)       found = PETSC_TRUE
  1409)       if (iarg+1 <= narg) then
  1410)         call getCommandLineArgument(iarg+1,string2)
  1411)         call InputReadDouble(string2,option,double_value,ierr)
  1412)       else
  1413)         ierr = 1
  1414)       endif
  1415)       if (InputError(ierr)) then
  1416)         option%io_buffer = 'Real argument for command line argument "' // &
  1417)                            trim(adjustl(string)) // '" not found.'
  1418)         call printErrMsg(option)
  1419)       endif
  1420)       exit
  1421)     endif
  1422)   enddo
  1423)   
  1424) end subroutine InputGetCommandLineReal
  1425) 
  1426) ! ************************************************************************** !
  1427) 
  1428) subroutine InputGetCommandLineString(string,string_value,found,option)
  1429)   ! 
  1430)   ! Returns a string associated with a command
  1431)   ! line argument
  1432)   ! 
  1433)   ! Author: Glenn Hammond
  1434)   ! Date: 02/05/09
  1435)   ! 
  1436) 
  1437)   use String_module
  1438)   use Option_module
  1439)   
  1440)   implicit none
  1441) 
  1442)   character(len=MAXSTRINGLENGTH) :: string
  1443)   type(option_type) :: option
  1444)   PetscBool :: found
  1445)   character(len=MAXSTRINGLENGTH) :: string_value
  1446) 
  1447)   PetscInt :: iarg, narg
  1448)   character(len=MAXSTRINGLENGTH) :: string2
  1449)   PetscErrorCode :: ierr
  1450)   
  1451)   ierr = 0
  1452)   ! do not initialize int_value, as it may already have a value
  1453)   found = PETSC_FALSE
  1454)   narg = getCommandLineArgumentCount()
  1455)   string = adjustl(string)
  1456)   do iarg = 1, narg
  1457)     call getCommandLineArgument(iarg,string2)
  1458)     if (StringCompare(string,string2)) then
  1459)       found = PETSC_TRUE
  1460)       if (iarg+1 <= narg) then
  1461)         call getCommandLineArgument(iarg+1,string2)
  1462)         call InputReadNChars(string2,string_value,MAXSTRINGLENGTH, &
  1463)                              PETSC_TRUE,ierr)
  1464)         if (string_value(1:1) == '-') then
  1465)           ! no argument exists
  1466)           option%io_buffer = 'String argument (' // &
  1467)                              trim(adjustl(string_value)) // & 
  1468)                              ') for command line argument "' // &
  1469)                              trim(adjustl(string)) // '" not recognized.'
  1470)           call printErrMsg(option)
  1471)         endif
  1472)       else
  1473)         ierr = 1
  1474)       endif
  1475)       if (InputError(ierr)) then
  1476)         option%io_buffer = 'String argument for command line argument "' // &
  1477)                            trim(adjustl(string)) // '" not found.'
  1478)         call printErrMsg(option)
  1479)       endif
  1480)       exit
  1481)     endif
  1482)   enddo
  1483)   
  1484) end subroutine InputGetCommandLineString
  1485) 
  1486) ! ************************************************************************** !
  1487) 
  1488) subroutine InputGetCommandLineTruth(string,truth_value,found,option)
  1489)   ! 
  1490)   ! Returns logical associated with a command
  1491)   ! line argument
  1492)   ! 
  1493)   ! Author: Glenn Hammond
  1494)   ! Date: 02/05/09
  1495)   ! 
  1496) 
  1497)   use String_module
  1498)   use Option_module
  1499)   
  1500)   implicit none
  1501) 
  1502)   character(len=MAXSTRINGLENGTH) :: string
  1503)   type(option_type) :: option
  1504)   PetscBool :: found
  1505)   PetscBool :: truth_value
  1506) 
  1507)   PetscInt :: iarg, narg
  1508)   character(len=MAXSTRINGLENGTH) :: string2
  1509)   character(len=MAXWORDLENGTH) :: word
  1510)   PetscErrorCode :: ierr
  1511)   
  1512)   ierr = 0
  1513)   ! do not initialize int_value, as it may already have a value
  1514)   found = PETSC_FALSE
  1515)   narg = getCommandLineArgumentCount()
  1516)   string = adjustl(string)
  1517)   do iarg = 1, narg
  1518)     call getCommandLineArgument(iarg,string2)
  1519)     if (StringCompare(string,string2)) then
  1520)       found = PETSC_TRUE
  1521)       if (iarg+1 <= narg) then
  1522)         call getCommandLineArgument(iarg+1,string2)
  1523)         call InputReadWord(string2,word,PETSC_TRUE,ierr)
  1524)       else
  1525)         ! check if no argument exists, which is valid and means 'true'
  1526)         truth_value = PETSC_TRUE
  1527)         exit
  1528)       endif    
  1529)       if (word(1:1) == '-') then
  1530)         ! no argument exists, which is valid and means 'true'
  1531)         truth_value = PETSC_TRUE
  1532)         exit
  1533)       endif
  1534)       call StringToLower(word)
  1535)       select case(trim(word))
  1536)         case('yes','true','1','on')
  1537)           truth_value = PETSC_TRUE
  1538)         case('no','false','0','off')
  1539)           truth_value = PETSC_FALSE
  1540)         case default
  1541)           option%io_buffer = 'Truth argument for command line argument "' // &
  1542)                              trim(adjustl(string)) // '" not recognized.'
  1543)           call printErrMsg(option)
  1544)       end select
  1545)     endif
  1546)   enddo
  1547)   
  1548) end subroutine InputGetCommandLineTruth
  1549) 
  1550) ! ************************************************************************** !
  1551) 
  1552) function getCommandLineArgumentCount()
  1553)   ! 
  1554)   ! Returns the number of command line arguments
  1555)   ! 
  1556)   ! Author: Glenn Hammond
  1557)   ! Date: 02/05/10
  1558)   ! 
  1559) 
  1560)   implicit none
  1561)   
  1562)   integer :: iargc
  1563)   
  1564)   PetscInt :: getCommandLineArgumentCount
  1565)   
  1566)   ! initialize to zero
  1567)   getCommandLineArgumentCount = 0
  1568)   
  1569) #if defined(PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT)
  1570)   getCommandLineArgumentCount = command_argument_count()
  1571) #elif defined(PETSC_HAVE_GETARG)
  1572)   getCommandLineArgumentCount = iargc()
  1573) #endif
  1574) 
  1575) end function getCommandLineArgumentCount
  1576) 
  1577) ! ************************************************************************** !
  1578) 
  1579) subroutine getCommandLineArgument(i,arg)
  1580)   ! 
  1581)   ! Returns the ith command line argument
  1582)   ! 
  1583)   ! Author: Glenn Hammond
  1584)   ! Date: 02/05/10
  1585)   ! 
  1586) 
  1587)   implicit none
  1588)   
  1589)   PetscInt :: i
  1590)   character(len=*) :: arg
  1591) 
  1592)   integer*4 :: fortran_int
  1593) 
  1594)   fortran_int = i
  1595) #if defined(PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT)
  1596)   call get_command_argument(fortran_int,arg)
  1597) #elif defined(PETSC_HAVE_GETARG)
  1598)   call getarg(fortran_int,arg)
  1599) #endif
  1600) 
  1601) end subroutine getCommandLineArgument
  1602) 
  1603) ! ************************************************************************** !
  1604) 
  1605) subroutine InputReadFilenames(option,filenames)
  1606)   ! 
  1607)   ! Reads filenames for multi-simulation runs
  1608)   ! 
  1609)   ! Author: Glenn Hammond
  1610)   ! Date: 08/11/09
  1611)   ! 
  1612) 
  1613)   use Option_module
  1614) 
  1615)   type(option_type) :: option
  1616)   character(len=MAXSTRINGLENGTH), pointer :: filenames(:)
  1617) 
  1618)   character(len=MAXSTRINGLENGTH) :: string
  1619)   character(len=MAXSTRINGLENGTH) :: filename
  1620)   PetscInt :: filename_count
  1621)   type(input_type), pointer :: input
  1622)   PetscBool :: card_found
  1623) 
  1624)   input => InputCreate(IN_UNIT,option%input_filename,option)
  1625) 
  1626)   string = "FILENAMES"
  1627)   call InputFindStringInFile(input,option,string) 
  1628) 
  1629)   card_found = PETSC_FALSE
  1630)   if (InputError(input)) then
  1631)     ! if the FILENAMES card is not included, we will assume that only
  1632)     ! filenames exist in the file.
  1633)     rewind(input%fid)
  1634)   else
  1635)     card_found = PETSC_TRUE
  1636)   endif
  1637)     
  1638)   filename_count = 0     
  1639)   do
  1640)     call InputReadPflotranString(input,option)
  1641)     if (InputError(input)) exit
  1642)     if (InputCheckExit(input,option)) exit  
  1643)     call InputReadNChars(input,option,filename,MAXSTRINGLENGTH,PETSC_FALSE)
  1644)     filename_count = filename_count + 1
  1645)   enddo
  1646)   
  1647)   allocate(filenames(filename_count))
  1648)   filenames = ''
  1649)   rewind(input%fid) 
  1650) 
  1651)   if (card_found) then
  1652)     string = "FILENAMES"
  1653)     call InputFindStringInFile(input,option,string) 
  1654)   endif
  1655)   
  1656)   filename_count = 0     
  1657)   do
  1658)     call InputReadPflotranString(input,option)
  1659)     if (InputError(input)) exit
  1660)     if (InputCheckExit(input,option)) exit  
  1661)     call InputReadNChars(input,option,filename,MAXSTRINGLENGTH,PETSC_FALSE)
  1662)     filename_count = filename_count + 1
  1663)     filenames(filename_count) = filename
  1664)   enddo
  1665) 
  1666)   call InputDestroy(input)
  1667) 
  1668) end subroutine InputReadFilenames
  1669) 
  1670) ! ************************************************************************** !
  1671) 
  1672) function InputGetLineCount(input)
  1673) 
  1674)   implicit none
  1675)   
  1676)   type(input_type), pointer :: input
  1677)   PetscInt :: line_count
  1678)   PetscInt :: InputGetLineCount
  1679) 
  1680)   rewind(input%fid)
  1681) 
  1682)   line_count = 0
  1683)   do
  1684)     read(input%fid, '(a512)', iostat=input%ierr)
  1685)     if (InputError(input)) exit
  1686)     line_count = line_count + 1
  1687)   enddo
  1688)   
  1689)   InputGetLineCount = line_count
  1690)   
  1691) end function InputGetLineCount
  1692) 
  1693) ! ************************************************************************** !
  1694) 
  1695) subroutine InputReadToBuffer(input, buffer)
  1696) 
  1697)   implicit none
  1698)   
  1699)   type(input_type), pointer :: input
  1700)   character(len=MAXSTRINGLENGTH) :: buffer(:)
  1701)   character(len=MAXSTRINGLENGTH) :: string
  1702)   PetscInt :: line
  1703) 
  1704)   rewind(input%fid)
  1705)   line = 0
  1706)   do
  1707)     read(input%fid, '(a512)', iostat=input%ierr) string
  1708)     if (InputError(input)) exit
  1709)     line = line + 1
  1710)     buffer(line) = string
  1711)   end do
  1712)   
  1713) end subroutine InputReadToBuffer
  1714) 
  1715) ! ************************************************************************** !
  1716) 
  1717) subroutine InputReadASCIIDbase(filename,option)
  1718)   ! 
  1719)   ! Read in an ASCII database
  1720)   ! 
  1721)   ! Author: Glenn Hammond
  1722)   ! Date: 08/19/14
  1723)   ! 
  1724)   use Option_module
  1725)   use String_module
  1726)   
  1727)   implicit none
  1728)   
  1729)   character(len=MAXWORDLENGTH) :: filename
  1730)   type(option_type) :: option
  1731) 
  1732)   character(len=MAXSTRINGLENGTH) :: string
  1733)   character(len=MAXWORDLENGTH) :: word
  1734)   character(len=MAXWORDLENGTH), allocatable :: words(:)
  1735)   character(len=MAXWORDLENGTH) :: object_name
  1736)   type(input_type), pointer :: input
  1737)   PetscInt :: icount
  1738)   PetscInt :: value_count
  1739)   PetscInt :: value_index
  1740)   PetscInt :: value_type
  1741)   PetscInt :: num_values_in_dataset
  1742)   PetscInt :: num_words, num_ints, num_reals
  1743)   
  1744)   input => InputCreate(IUNIT_TEMP,filename,option)
  1745)   
  1746)   icount = 0
  1747)   num_values_in_dataset = 0
  1748)   num_ints = 0
  1749)   num_reals = 0
  1750)   num_words = 0
  1751)   do
  1752)     call InputReadPflotranString(input,option)
  1753)     if (InputError(input)) exit
  1754)     call InputReadWord(input,option,word,PETSC_FALSE)
  1755)     if (StringStartsWithAlpha(word)) then
  1756)       icount = icount + 1
  1757)       if (icount == 1) then
  1758)         string = input%buf
  1759)         do
  1760)           call InputReadWord(input,option,word,PETSC_TRUE)
  1761)           if (input%ierr /= 0) exit
  1762)           num_values_in_dataset = num_values_in_dataset + 1
  1763)         enddo
  1764)         input%buf = string
  1765)       endif
  1766)       input%ierr = 0
  1767)       call InputReadWord(input,option,word,PETSC_TRUE)
  1768)       call InputErrorMsg(input,option,'value','ASCII Dbase')
  1769)       select case(StringIntegerDoubleOrWord(word))
  1770)         case(STRING_IS_INTEGER)
  1771)           num_ints = num_ints + 1
  1772)         case(STRING_IS_DOUBLE)
  1773)           num_reals = num_reals + 1
  1774)         case(STRING_IS_WORD)
  1775)           num_words = num_words + 1
  1776)       end select
  1777)     endif
  1778)   enddo
  1779) 
  1780)   value_index = 1
  1781)   if (option%id > 0) then
  1782)     if (option%id > num_values_in_dataset) then
  1783)       write(word,*) num_values_in_dataset
  1784)         option%io_buffer = 'Data in DBASE_FILENAME "' // &
  1785)         trim(filename) // &
  1786)         '" is too small (' // trim(adjustl(word)) // &
  1787)         ') for number of realizations.'
  1788)       call printErrMsg(option)
  1789)     endif
  1790)     value_index = option%id
  1791)   endif
  1792)   allocate(words(num_values_in_dataset))
  1793)   words = ''
  1794)   
  1795)   rewind(input%fid)
  1796)   allocate(dbase)
  1797)   if (num_ints > 0) then
  1798)     allocate(dbase%icard(num_ints))
  1799)     dbase%icard = ''
  1800)     allocate(dbase%ivalue(num_ints))
  1801)     dbase%ivalue = UNINITIALIZED_INTEGER
  1802)   endif
  1803)   if (num_reals > 0) then
  1804)     allocate(dbase%rcard(num_reals))
  1805)     dbase%rcard = ''
  1806)     allocate(dbase%rvalue(num_reals))
  1807)     dbase%rvalue = UNINITIALIZED_DOUBLE
  1808)   endif
  1809)   if (num_words > 0) then
  1810)     allocate(dbase%ccard(num_words))
  1811)     dbase%ccard = ''
  1812)     allocate(dbase%cvalue(num_words))
  1813)     dbase%cvalue = '-999'
  1814)   endif
  1815)   num_ints = 0
  1816)   num_reals = 0
  1817)   num_words = 0
  1818)   do
  1819)     call InputReadPflotranString(input,option)
  1820)     if (InputError(input)) exit
  1821)     call InputReadWord(input,option,word,PETSC_FALSE)
  1822)     if (StringStartsWithAlpha(word)) then
  1823)       object_name = word
  1824)       words = ''
  1825)       value_count = 0
  1826)       do
  1827)         call InputReadWord(input,option,word,PETSC_TRUE)
  1828)         if (input%ierr /= 0) exit
  1829)         value_count = value_count + 1
  1830)         if (value_count <= num_values_in_dataset) &
  1831)           words(value_count) = word
  1832)       enddo
  1833)       if (value_count /= num_values_in_dataset) then
  1834)         write(word,*) value_count
  1835)         option%io_buffer = 'Data in DBASE_FILENAME "' // &
  1836)           trim(object_name) // &
  1837)           '" has an inconsistent number of values (' // &
  1838)           trim(adjustl(word)) // &
  1839)           ') for number of realizations ('
  1840)         write(word,*) num_values_in_dataset
  1841)         option%io_buffer = trim(option%io_buffer) // &
  1842)           trim(adjustl(word)) // ').'
  1843)         call printErrMsg(option)
  1844)       endif
  1845)       call StringToUpper(object_name)
  1846)       string = words(value_index)
  1847)       value_type = StringIntegerDoubleOrWord(string)
  1848)       string = words(value_index)
  1849)       select case(value_type)
  1850)         case(STRING_IS_INTEGER)
  1851)           num_ints = num_ints + 1
  1852)           dbase%icard(num_ints) = adjustl(object_name)
  1853)           call InputReadInt(string,option,dbase%ivalue(num_ints),input%ierr)
  1854)           call InputErrorMsg(input,option,'ivalue','ASCII Dbase '//object_name)
  1855)         case(STRING_IS_DOUBLE)
  1856)           num_reals = num_reals + 1
  1857)           dbase%rcard(num_reals) = adjustl(object_name)
  1858)           call InputReadDouble(string,option,dbase%rvalue(num_reals),input%ierr)
  1859)           call InputErrorMsg(input,option,'rvalue','ASCII Dbase '//object_name)
  1860)         case(STRING_IS_WORD)
  1861)           num_words = num_words + 1
  1862)           dbase%ccard(num_words) = adjustl(object_name)
  1863)           dbase%cvalue(num_words) = words(value_index)
  1864)       end select
  1865)     endif
  1866)   enddo
  1867)   deallocate(words)
  1868)   
  1869)   call InputDestroy(input)
  1870)   
  1871) end subroutine InputReadASCIIDbase
  1872) 
  1873) ! ************************************************************************** !
  1874) 
  1875) subroutine InputParseDbaseForInt(buffer,value,found,ierr)
  1876)   ! 
  1877)   ! Parses database for an integer value
  1878)   ! 
  1879)   ! Author: Glenn Hammond
  1880)   ! Date: 08/19/14
  1881)   ! 
  1882)   use String_module
  1883)   
  1884)   implicit none
  1885)   
  1886)   character(len=MAXSTRINGLENGTH) :: buffer
  1887)   PetscInt :: value
  1888)   PetscBool :: found
  1889)   PetscErrorCode :: ierr
  1890) 
  1891)   character(len=MAXSTRINGLENGTH) :: buffer_save
  1892)   character(len=MAXWORDLENGTH) :: word
  1893)   character(len=MAXWORDLENGTH) :: dbase_keyword = 'DBASE_VALUE'
  1894)   
  1895)   buffer_save = buffer
  1896)   found = PETSC_FALSE
  1897)   call InputReadWord(buffer,word,PETSC_TRUE,ierr)
  1898)   if (StringCompareIgnoreCase(word,dbase_keyword)) then
  1899)     call InputReadWord(buffer,word,PETSC_TRUE,ierr)
  1900)     call DbaseLookupInt(word,value,ierr)
  1901)     if (ierr == 0) then
  1902)       found = PETSC_TRUE
  1903)     endif
  1904)   else
  1905)     buffer = buffer_save
  1906)   endif
  1907)   
  1908) end subroutine InputParseDbaseForInt
  1909) 
  1910) ! ************************************************************************** !
  1911) 
  1912) subroutine InputParseDbaseForDouble(buffer,value,found,ierr)
  1913)   ! 
  1914)   ! Parses database for an double precision value
  1915)   ! 
  1916)   ! Author: Glenn Hammond
  1917)   ! Date: 08/19/14
  1918)   ! 
  1919)   use String_module
  1920)   
  1921)   implicit none
  1922)   
  1923)   character(len=MAXSTRINGLENGTH) :: buffer
  1924)   PetscReal :: value
  1925)   PetscBool :: found
  1926)   PetscErrorCode :: ierr
  1927) 
  1928)   character(len=MAXSTRINGLENGTH) :: buffer_save
  1929)   character(len=MAXWORDLENGTH) :: word
  1930)   character(len=MAXWORDLENGTH) :: dbase_keyword = 'DBASE_VALUE'
  1931)   
  1932)   buffer_save = buffer
  1933)   found = PETSC_FALSE
  1934)   call InputReadWord(buffer,word,PETSC_TRUE,ierr)
  1935)   if (StringCompareIgnoreCase(word,dbase_keyword)) then
  1936)     call InputReadWord(buffer,word,PETSC_TRUE,ierr)
  1937)     call DbaseLookupDouble(word,value,ierr)
  1938)     if (ierr == 0) then
  1939)       found = PETSC_TRUE
  1940)     endif
  1941)   else
  1942)     buffer = buffer_save
  1943)   endif
  1944)   
  1945) end subroutine InputParseDbaseForDouble
  1946) 
  1947) ! ************************************************************************** !
  1948) 
  1949) subroutine InputParseDbaseForWord(buffer,value,found,ierr)
  1950)   ! 
  1951)   ! Parses database for a word
  1952)   ! 
  1953)   ! Author: Glenn Hammond
  1954)   ! Date: 05/22/16
  1955)   ! 
  1956)   use String_module
  1957)   
  1958)   implicit none
  1959)   
  1960)   character(len=MAXSTRINGLENGTH) :: buffer
  1961)   character(len=MAXWORDLENGTH) :: value
  1962)   PetscBool :: found
  1963)   PetscErrorCode :: ierr
  1964) 
  1965)   character(len=MAXSTRINGLENGTH) :: buffer_save
  1966)   character(len=MAXWORDLENGTH) :: word
  1967)   character(len=MAXWORDLENGTH) :: dbase_keyword = 'DBASE_VALUE'
  1968)   
  1969)   buffer_save = buffer
  1970)   found = PETSC_FALSE
  1971)   call InputReadWord(buffer,word,PETSC_TRUE,ierr)
  1972)   if (StringCompareIgnoreCase(word,dbase_keyword)) then
  1973)     call InputReadWord(buffer,word,PETSC_TRUE,ierr)
  1974)     call DbaseLookupWord(word,value,ierr)
  1975)     if (ierr == 0) then
  1976)       found = PETSC_TRUE
  1977)     endif
  1978)   else
  1979)     buffer = buffer_save
  1980)   endif
  1981)   
  1982) end subroutine InputParseDbaseForWord
  1983) 
  1984) ! ************************************************************************** !
  1985) 
  1986) subroutine DbaseLookupInt(keyword,value,ierr)
  1987)   ! 
  1988)   ! Looks up double precision value in database
  1989)   ! 
  1990)   ! Author: Glenn Hammond
  1991)   ! Date: 08/19/14
  1992)   ! 
  1993)   use String_module
  1994)   
  1995)   implicit none
  1996)   
  1997)   character(len=MAXWORDLENGTH) :: keyword
  1998)   PetscInt :: value
  1999)   PetscErrorCode :: ierr
  2000)   
  2001)   PetscInt :: i
  2002)   PetscBool :: found
  2003) 
  2004)   ierr = 0
  2005)   
  2006)   call StringToUpper(keyword)
  2007)   
  2008)   found = PETSC_FALSE
  2009)   if (associated(dbase%icard)) then
  2010)     do i = 1, size(dbase%icard)
  2011)       if (StringCompare(keyword,dbase%icard(i))) then
  2012)         found = PETSC_TRUE
  2013)         value = dbase%ivalue(i)
  2014)         exit
  2015)       endif
  2016)     enddo
  2017)   endif
  2018)   
  2019)   if (.not.found) then
  2020)     ierr = 1
  2021)   endif
  2022)   
  2023) end subroutine DbaseLookupInt
  2024) 
  2025) ! ************************************************************************** !
  2026) 
  2027) subroutine DbaseLookupDouble(keyword,value,ierr)
  2028)   ! 
  2029)   ! Looks up double precision value in database
  2030)   ! 
  2031)   ! Author: Glenn Hammond
  2032)   ! Date: 08/19/14
  2033)   ! 
  2034)   use String_module
  2035)   
  2036)   implicit none
  2037)   
  2038)   character(len=MAXWORDLENGTH) :: keyword
  2039)   PetscReal :: value
  2040)   PetscErrorCode :: ierr
  2041)   
  2042)   PetscInt :: i
  2043)   PetscBool :: found
  2044) 
  2045)   ierr = 0
  2046)   
  2047)   call StringToUpper(keyword)
  2048)   
  2049)   found = PETSC_FALSE
  2050)   if (associated(dbase%rcard)) then
  2051)     do i = 1, size(dbase%rcard)
  2052)       if (StringCompare(keyword,dbase%rcard(i))) then
  2053)         found = PETSC_TRUE
  2054)         value = dbase%rvalue(i)
  2055)         exit
  2056)       endif
  2057)     enddo
  2058)   endif
  2059)   
  2060)   if (.not.found) then
  2061)     ierr = 1
  2062)   endif
  2063)   
  2064) end subroutine DbaseLookupDouble
  2065) 
  2066) ! ************************************************************************** !
  2067) 
  2068) subroutine DbaseLookupWord(keyword,value,ierr)
  2069)   ! 
  2070)   ! Looks up double precision value in database
  2071)   ! 
  2072)   ! Author: Glenn Hammond
  2073)   ! Date: 08/19/14
  2074)   ! 
  2075)   use String_module
  2076)   
  2077)   implicit none
  2078)   
  2079)   character(len=MAXWORDLENGTH) :: keyword
  2080)   character(len=MAXWORDLENGTH) :: value
  2081)   PetscErrorCode :: ierr
  2082)   
  2083)   PetscInt :: i
  2084)   PetscBool :: found
  2085) 
  2086)   ierr = 0
  2087)   
  2088)   call StringToUpper(keyword)
  2089)   
  2090)   found = PETSC_FALSE
  2091)   if (associated(dbase%ccard)) then
  2092)     do i = 1, size(dbase%ccard)
  2093)       if (StringCompare(keyword,dbase%ccard(i))) then
  2094)         found = PETSC_TRUE
  2095)         value = dbase%cvalue(i)
  2096)         exit
  2097)       endif
  2098)     enddo
  2099)   endif
  2100)   
  2101)   if (.not.found) then
  2102)     ierr = 1
  2103)   endif
  2104)   
  2105) end subroutine DbaseLookupWord
  2106) 
  2107) ! ************************************************************************** !
  2108) 
  2109) subroutine InputKeywordUnrecognized1(keyword,string,option)
  2110)   ! 
  2111)   ! Looks up double precision value in database
  2112)   ! 
  2113)   ! Author: Glenn Hammond
  2114)   ! Date: 08/19/14
  2115)   ! 
  2116)   use Option_module
  2117)   
  2118)   implicit none
  2119)   
  2120)   character(len=*) :: keyword
  2121)   character(len=*) :: string
  2122)   type(option_type) :: option
  2123) 
  2124)   character(len=1) :: null_string
  2125) 
  2126)   null_string = '' 
  2127)   call InputKeywordUnrecognized2(keyword,string,null_string,option)
  2128)   
  2129) end subroutine InputKeywordUnrecognized1
  2130) 
  2131) ! ************************************************************************** !
  2132) 
  2133) subroutine InputKeywordUnrecognized2(keyword,string,string2,option)
  2134)   ! 
  2135)   ! Looks up double precision value in database
  2136)   ! 
  2137)   ! Author: Glenn Hammond
  2138)   ! Date: 08/19/14
  2139)   ! 
  2140)   use Option_module
  2141)   
  2142)   implicit none
  2143)   
  2144)   character(len=*) :: keyword
  2145)   character(len=*) :: string
  2146)   character(len=*) :: string2
  2147)   type(option_type) :: option
  2148)   
  2149)   option%io_buffer = 'Keyword "' // &
  2150)                      trim(keyword) // &
  2151)                      '" not recognized in ' // &
  2152)                      trim(string) // '.'
  2153)   if (len_trim(string2) > 0) then
  2154)     option%io_buffer = trim(option%io_buffer) // ' ' // &
  2155)                      trim(string2) // '.'
  2156)   endif
  2157)   call printErrMsg(option)
  2158)   
  2159) end subroutine InputKeywordUnrecognized2
  2160) 
  2161) ! ************************************************************************** !
  2162) 
  2163) subroutine InputCheckMandatoryUnits(input,option)
  2164)   ! 
  2165)   ! Looks up double precision value in database
  2166)   ! 
  2167)   ! Author: Glenn Hammond
  2168)   ! Date: 08/19/14
  2169)   ! 
  2170)   use Option_module
  2171)   
  2172)   implicit none
  2173)   
  2174)   type(input_type) :: input
  2175)   type(option_type) :: option
  2176)   
  2177)   if (input%force_units) then
  2178)     option%io_buffer = 'Missing units'
  2179)     if (len_trim(input%err_buf) > 1) then
  2180)       option%io_buffer = trim(option%io_buffer) // ' in ' // &
  2181)                          trim(input%err_buf) // '.'
  2182)     endif
  2183)     call printErrMsg(option)
  2184)   endif
  2185)   
  2186) end subroutine InputCheckMandatoryUnits
  2187) 
  2188) ! ************************************************************************** !
  2189) 
  2190) subroutine InputReadAndConvertUnits(input,double_value,internal_units, &
  2191)                                     keyword_string,option)
  2192)   ! 
  2193)   ! Reads units if they exist and returns the units conversion factor.
  2194)   ! 
  2195)   ! Author: Glenn Hammond
  2196)   ! Date: 07/26/16
  2197)   ! 
  2198)   use Option_module
  2199)   use Units_module
  2200)   
  2201)   implicit none
  2202)   
  2203)   type(input_type) :: input
  2204)   PetscReal :: double_value
  2205)   character(len=*) :: internal_units
  2206)   character(len=*) :: keyword_string
  2207)   type(option_type) :: option
  2208) 
  2209)   character(len=MAXWORDLENGTH) :: units
  2210)   character(len=MAXWORDLENGTH) :: internal_units_word
  2211) 
  2212)   call InputReadWord(input,option,units,PETSC_TRUE)
  2213)   if (input%ierr == 0) then
  2214)     if (len_trim(internal_units) < 1) then
  2215)       option%io_buffer = 'No internal units provided in &
  2216)                          &InputReadAndConvertUnits()'
  2217)       call printErrMsg(option)
  2218)     endif
  2219)     internal_units_word = trim(internal_units)
  2220)     double_value = double_value * &
  2221)                    UnitsConvertToInternal(units,internal_units_word,option)
  2222)   else
  2223)     call InputDefaultMsg(input,option,keyword_string)
  2224)   endif
  2225)   
  2226) end subroutine InputReadAndConvertUnits
  2227) 
  2228) ! ************************************************************************** !
  2229) 
  2230) subroutine InputPushExternalFile(input,option)
  2231)   ! 
  2232)   ! Looks up double precision value in database
  2233)   ! 
  2234)   ! Author: Glenn Hammond
  2235)   ! Date: 08/19/14
  2236)   ! 
  2237)   use Option_module
  2238)   
  2239)   implicit none
  2240)   
  2241)   type(input_type), pointer :: input
  2242)   type(option_type) :: option
  2243) 
  2244)   character(len=MAXSTRINGLENGTH) :: string
  2245)   type(input_type), pointer :: input_child
  2246)   
  2247)   call InputReadNChars(input,option,string,MAXSTRINGLENGTH,PETSC_TRUE)
  2248)   call InputErrorMsg(input,option,'filename','EXTERNAL_FILE')
  2249)   input_child => InputCreate(input%fid+1,string,option) 
  2250)   input_child%parent => input
  2251)   input => input_child
  2252) 
  2253) end subroutine InputPushExternalFile
  2254) 
  2255) ! ************************************************************************** !
  2256) 
  2257) function InputPopExternalFile(input)
  2258)   ! 
  2259)   ! Looks up double precision value in database
  2260)   ! 
  2261)   ! Author: Glenn Hammond
  2262)   ! Date: 08/19/14
  2263)   ! 
  2264)   
  2265)   implicit none
  2266)   
  2267)   type(input_type), pointer :: input
  2268) 
  2269)   PetscBool :: InputPopExternalFile
  2270)   type(input_type), pointer :: input_parent
  2271)   
  2272)   InputPopExternalFile = PETSC_FALSE
  2273)   if (associated(input%parent)) then
  2274)     input_parent => input%parent
  2275)     call InputDestroy(input)
  2276)     input => input_parent
  2277)     nullify(input_parent)
  2278)     InputPopExternalFile = PETSC_TRUE
  2279)   endif
  2280) 
  2281) end function InputPopExternalFile
  2282) 
  2283) ! ************************************************************************** !
  2284) 
  2285) subroutine InputDbaseDestroy()
  2286)   ! 
  2287)   ! Destroys the input dbase and members
  2288)   ! 
  2289)   ! Author: Glenn Hammond
  2290)   ! Date: 08/20/14
  2291)   ! 
  2292) 
  2293)   implicit none
  2294)   
  2295)   if (associated(dbase)) then
  2296)     ! due to circular dependencies, cannot use Utilty_module::DeallocateArray 
  2297)     if (associated(dbase%icard)) deallocate(dbase%icard)
  2298)     nullify(dbase%icard)
  2299)     if (associated(dbase%rcard)) deallocate(dbase%rcard)
  2300)     nullify(dbase%rcard)
  2301)     if (associated(dbase%ccard)) deallocate(dbase%ccard)
  2302)     nullify(dbase%ccard)
  2303)     if (associated(dbase%ivalue)) deallocate(dbase%ivalue)
  2304)     nullify(dbase%ivalue)
  2305)     if (associated(dbase%rvalue)) deallocate(dbase%rvalue)
  2306)     nullify(dbase%rvalue)
  2307)     if (associated(dbase%cvalue)) deallocate(dbase%cvalue)
  2308)     nullify(dbase%cvalue)
  2309)     deallocate(dbase)
  2310)     nullify(dbase)
  2311)   endif
  2312)   
  2313) end subroutine InputDbaseDestroy
  2314) 
  2315) ! ************************************************************************** !
  2316) 
  2317) subroutine InputDestroy(input)
  2318)   ! 
  2319)   ! Deallocates an input object
  2320)   ! 
  2321)   ! Author: Glenn Hammond
  2322)   ! Date: 11/10/08
  2323)   ! 
  2324) 
  2325)   implicit none
  2326)   
  2327)   type(input_type), pointer :: input
  2328)   
  2329)   if (input%fid /= 0) close(input%fid)
  2330)   input%fid = 0
  2331)   deallocate(input)
  2332)   nullify(input)
  2333)   
  2334) end subroutine InputDestroy
  2335) 
  2336) end module Input_Aux_module

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