1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015 |
- !#################################################################
- !
- ! call ReadRc( rcfile, 'test.flag', l, status [,default=.false.] )
- !
- ! return status :
- ! <0 : key not found, value set to default
- ! 0 : key found and value read without errors
- ! >0 : some errors
- !
- ! Search for extended keys:
- !
- ! call ReadRc( rcfile, 'test', (/'* ','all','b '/), flag, status, default=.true. )
- !
- ! will search for (dots are inserted automatically):
- !
- ! test.* : F
- ! test.all : F
- ! test.b : T
- !
- ! The last found key overwrites all previous values.
- !
- !#################################################################
- !
- #define TRACEBACK write (gol,'("in ",a," (",a,", line",i5,")")') rname, __FILE__, __LINE__; call goErr
- #define IF_NOTOK_RETURN(action) if (status/=0) then; TRACEBACK; action; return; end if
- #define IF_ERROR_RETURN(action) if (status> 0) then; TRACEBACK; action; return; end if
- !
- !#################################################################
- module GO_Rc
- implicit none
- ! --- in/out ---------------------
- private
- public :: TrcFile, RcBuffer
- public :: Init, Done
- public :: ReadRc
- ! --- const ---------------------------------
-
- character(len=*), parameter :: mname = 'GO_Rc'
- ! maximum line length in rc file:
- integer, parameter :: buflen = 512
- ! --- types ---------------------------------
- type RcBuffer
- character(len=buflen) :: key
- character(len=buflen) :: value
- end type RcBuffer
- type TrcFile
- character(len=80) :: fname
- integer :: rcitems
- type(RcBuffer),dimension(:), pointer :: Rc_Table
- end type TrcFile
-
- ! --- interfaces -------------------------------------
- interface Init
- module procedure rcfile_Init
- end interface
- interface Done
- module procedure rcfile_Done
- end interface
- interface ReadRc
- module procedure ReadRc_i
- module procedure ReadRcs_i
- module procedure ReadRc_i1
- module procedure ReadRc_r
- module procedure ReadRcs_r
- module procedure ReadRc_r1
- module procedure ReadRc_l
- module procedure ReadRcs_l
- module procedure ReadRc_s
- module procedure ReadRcs_s
- end interface
- contains
- ! ================================================================
- ! ===
- ! === init, done
- ! ===
- ! ================================================================
- subroutine rcfile_Init( rcfile, fname, status )
- use GO_Print, only : gol, goErr
- ! --- in/out ---------------------------
- type(TrcFile), intent(out) :: rcfile
- character(len=*), intent(in) :: fname
- integer, intent(out) :: status
-
- ! --- const ---------------------------
-
- character(len=*), parameter :: rname = mname//'/rcfile_Init'
-
- ! --- local --------------------------
-
- logical :: exist=.False.
- ! --- begin ---------------------------
- ! file not present ?
- inquire( file=trim(fname), exist=exist )
- if ( .not. exist ) then
- write (gol,'("rcfile not found :")'); call goErr
- write (gol,'(" ",a)') trim(fname); call goErr
- TRACEBACK; status=1; return
- end if
- ! store file name:
- rcfile%fname = trim(fname)
-
- ! empty yet:
- rcfile%rcitems = 0
- nullify( rcfile%Rc_Table )
-
- ! parse rcfile: read and store keys and values in a table
- call Parse_Rcfile(rcfile,status)
- if (status/=0) then
- write (gol,'("rcfile seems empty")'); call goErr
- write (gol,'(" ",a)') trim(fname); call goErr
- TRACEBACK; status=1; return
- end if
- ! ok
- status = 0
- end subroutine rcfile_Init
- ! ***
- subroutine rcfile_Done( rcfile, status )
- ! --- in/out ---------------------------
- type(TrcFile), intent(inout) :: rcfile
- integer, intent(out) :: status
- ! --- const ---------------------------
-
- character(len=*), parameter :: rname = mname//'/rcfile_Done'
-
- ! --- begin ---------------------------
- if ( associated(rcfile%Rc_Table) ) deallocate(rcfile%Rc_Table)
- nullify( rcfile%Rc_Table )
-
- ! ok
- status = 0
- end subroutine rcfile_Done
- ! ================================================================
- ! ===
- ! === parse rcfile into memory
- ! ===
- ! ================================================================
- subroutine Parse_Rcfile( rcfile, status )
- use GO_Print , only : gol, goErr
- use GO_String, only : goSplitLine, goTab2Space
- use GO_File , only : TTextFile, Init, Done, ReadLine, RewindFile
- ! --- in/out ----------------------
- type(TrcFile), intent(inout) :: rcfile
- integer, intent(out) :: status
- ! --- const ---------------------------
-
- character(len=*), parameter :: rname = mname//'/ParseRcfile'
-
- ! --- local -----------------------
- type(TTextFile) :: file
- integer :: iostat
- Integer :: nfound
- character(len=512) :: s, skey, sdata
- integer :: l
- ! --- begin --------------------------
- ! open commented text file:
- call Init( file, rcfile%fname, status, status='old', comment='!' )
- IF_NOTOK_RETURN(status=1)
- ! no matching lines found yet ...
- nfound = 0
-
- ! count all lines
- do
- ! read next non empty, non comment line:
- call ReadLine( file, s, status )
- if (status<0) exit ! end of file
- nfound = nfound + 1
- IF_NOTOK_RETURN(status=1)
- enddo
- RcFile%rcitems = nfound
- if ( associated (rcfile%Rc_Table) ) deallocate(rcfile%Rc_Table)
- allocate(rcfile%Rc_Table(nfound), stat = status)
- IF_NOTOK_RETURN(status=1)
- call RewindFile(file, status)
- IF_NOTOK_RETURN(status=1)
- ! parse file in buffer:
- nfound = 0
- do
- ! read next non empty, non comment line:
- call ReadLine( file, s, status )
- if (status<0) exit ! end of file
- nfound = nfound + 1
- IF_NOTOK_RETURN(status=1)
-
- ! Andy Jacobson, 10 Apr 2006. Allows tabs in rc file.
- call goTab2Space( s )
- ! split at colon:
- call goSplitLine( s, skey, ':', sdata, status )
- IF_NOTOK_RETURN(status=1)
-
- rcfile%Rc_Table(nfound)%key = trim(skey)
- rcfile%Rc_Table(nfound)%value = trim(sdata)
- end do
- ! close:
- call Done( file, status )
- IF_NOTOK_RETURN(status=1)
-
- ! not found ? warning status
- if ( nfound == 0 ) then
- status=-1; return
- end if
- ! ok
- status = 0
- end subroutine Parse_Rcfile
- ! ================================================================
- ! ===
- ! === general read
- ! ===
- ! ================================================================
- ! Searches the file <filenameResource> for the string
- ! "<key> : "
- ! and save all characters behind the equal sign in <buffer>.
- ! The Resource file may contain comment lines starting with a "!"
- subroutine ReadRcItem( rcfile, key, buffer, status )
- use GO_Print , only : gol, goErr
- ! --- in/out ----------------------
- type(TrcFile), intent(in) :: rcfile
- character(len=*), intent(in) :: key
- character(len=*), intent(out) :: buffer
- integer, intent(out) :: status
- ! --- const ---------------------------
-
- character(len=*), parameter :: rname = mname//'/ReadRcItem'
-
- ! --- local -----------------------
- Integer :: nfound
- character(len=512) :: skey
- integer :: l, i
- ! --- begin --------------------------
- ! no matching lines found yet ...
- nfound = 0
-
- ! scan all lines
- do i=1,rcfile%rcitems
- ! starts with requested key, and no extra text between key and colon ? then found!
- skey = rcfile%Rc_Table(i)%key
- if ( (index(skey,key)==1) .and. (len_trim(key)==len_trim(skey))) then
- buffer = rcfile%Rc_Table(i)%value
- nfound = nfound + 1
- end if
- end do
-
- ! not found ? warning status
- if ( nfound == 0 ) then
- status=-1; return
- end if
- ! multiple matches ?
- if ( nfound > 1 ) then
- write (gol,'("found more than one matching keys in rcfile:")'); call goErr
- write (gol,'(" rcfile : ",a)') trim(rcfile%fname); call goErr
- write (gol,'(" key : ",a)') trim(key); call goErr
- write (gol,'(" found : ",i4," times")') nfound
- TRACEBACK; status=1; return
- end if
- ! ok
- status = 0
- end subroutine ReadRcItem
-
-
- ! ================================================================
- ! ===
- ! === integer
- ! ===
- ! ================================================================
- subroutine ReadRc_i( rcfile, key, i, status, default )
- use GO_Print, only : gol, goErr
- ! --- in/out ----------------------------
- type(TrcFile), intent(in) :: rcfile
- character(len=*), intent(in) :: key
- integer, intent(out) :: i
- integer, intent(out) :: status
-
- integer, intent(in), optional :: default
-
- ! --- const ----------------------------
-
- character(len=*), parameter :: rname = mname//'/ReadRc_i'
- ! --- local -----------------------------
- character(len=buflen) :: buffer
- ! --- begin -----------------------------
- ! search key line in rcfile:
- call ReadRcItem( rcfile, key, buffer, status )
- if ( status < 0 ) then
- ! not found; set to default or leave with error:
- if ( present(default) ) then
- i = default
- status = -1 ; return
- else
- write (gol,'("key not found and no default specified ...")'); call goErr
- write (gol,'(" rcfile : ",a)') trim(rcfile%fname); call goErr
- write (gol,'(" key : ",a)') trim(key); call goErr
- TRACEBACK; status=1; return
- end if
- else if ( status == 0 ) then
- ! key found; set value:
- read (buffer,*,iostat=status) i
- if ( status /= 0 ) then
- write (gol,'("while reading integer:")'); call goErr
- write (gol,'(" rcfile : ",a)') trim(rcfile%fname); call goErr
- write (gol,'(" key : ",a)') trim(key); call goErr
- write (gol,'(" value : ",a)') trim(buffer); call goErr
- TRACEBACK; status=1; return
- end if
- else
- ! some error ...
- TRACEBACK; status=1; return
- end if
-
- ! ok
- status = 0
- end subroutine ReadRc_i
- ! ***
-
- subroutine ReadRcs_i( rcfile, key, keys, i, status, default )
- use GO_Print, only : gol, goErr
- ! --- in/out ----------------------------
- type(TrcFile), intent(in) :: rcfile
- character(len=*), intent(in) :: key
- character(len=*), intent(in) :: keys(:)
- integer, intent(out) :: i
- integer, intent(out) :: status
-
- integer, intent(in), optional :: default
-
- ! --- const ----------------------------
-
- character(len=*), parameter :: rname = mname//'/ReadRcs_i'
- ! --- local -----------------------------
-
- logical :: found
- integer :: ikey
- integer :: i_curr
- ! --- begin -----------------------------
-
- ! pessimistic assumption ...
- found = .false.
-
- ! loop over all key extensions:
- do ikey = 1, size(keys)
-
- ! try to read key;
- ! provide default to return without error if key is not found:
- call ReadRc( rcfile, trim(key)//'.'//trim(keys(ikey)), i_curr, status, default=0 )
- if ( status < 0 ) then
- ! not found; try next
- cycle
- else if ( status == 0 ) then
- ! found and value read:
- found = .true.
- i = i_curr
- else
- ! error ...
- TRACEBACK; status=1; return
- end if
-
- end do ! loop over keys
-
- ! not found ?
- if ( .not. found ) then
- ! default provided ?
- if ( present(default) ) then
- ! set to default:
- i = default
- else
- ! error ...
- write (gol,'("key(s) not found and no default specified ...")'); call goErr
- write (gol,'(" rcfile : ",a)') trim(rcfile%fname); call goErr
- do ikey = 1, size(keys)
- write (gol,'(" key : ",a,".",a)') trim(key), trim(keys(ikey)); call goErr
- end do
- TRACEBACK; status=1; return
- end if
- end if
-
- ! ok
- status = 0
- end subroutine ReadRcs_i
- ! ***
- subroutine ReadRc_i1( rcfile, key, i, status, default )
- use GO_Print, only : gol, goErr
- ! --- in/out ----------------------------
- type(TrcFile), intent(in) :: rcfile
- character(len=*), intent(in) :: key
- integer, intent(out) :: i(:)
- integer, intent(out) :: status
-
- integer, intent(in), optional :: default
-
- ! --- const ----------------------------
-
- character(len=*), parameter :: rname = mname//'/ReadRc_i1'
- ! --- local -----------------------------
- character(len=buflen) :: buffer
- ! --- begin -----------------------------
- ! search key line in rcfile:
- call ReadRcItem( rcfile, key, buffer, status )
- if ( status < 0 ) then
- ! not found; set to default or leave with error:
- if ( present(default) ) then
- i = default
- status = -1 ; return
- else
- write (gol,'("key not found and no default specified ...")'); call goErr
- write (gol,'(" rcfile : ",a)') trim(rcfile%fname); call goErr
- write (gol,'(" key : ",a)') trim(key); call goErr
- TRACEBACK; status=1; return
- end if
- else if ( status == 0 ) then
- ! key found; set value:
- read (buffer,*,iostat=status) i
- if ( status /= 0 ) then
- write (gol,'("while reading integer:")'); call goErr
- write (gol,'(" rcfile : ",a)') trim(rcfile%fname); call goErr
- write (gol,'(" key : ",a)') trim(key); call goErr
- write (gol,'(" value : ",a)') trim(buffer); call goErr
- TRACEBACK; status=1; return
- end if
- else
- ! some error ...
- TRACEBACK; status=1; return
- end if
-
- ! ok
- status = 0
- end subroutine ReadRc_i1
- ! ================================================================
- ! ===
- ! === real
- ! ===
- ! ================================================================
- subroutine ReadRc_r( rcfile, key, r, status, default )
- use GO_Print, only : gol, goErr
- ! --- in/out ----------------------------
- type(TrcFile), intent(in) :: rcfile
- character(len=*), intent(in) :: key
- real, intent(out) :: r
- integer, intent(out) :: status
-
- real, intent(in), optional :: default
-
- ! --- const ----------------------------
-
- character(len=*), parameter :: rname = mname//'/ReadRc_r'
- ! --- local -----------------------------
- character(len=buflen) :: buffer
- ! --- begin -----------------------------
- ! search key line in rcfile:
- call ReadRcItem( rcfile, key, buffer, status )
- if ( status < 0 ) then
- ! not found; set to default or leave with error:
- if ( present(default) ) then
- r = default
- status = -1 ; return
- else
- write (gol,'("key not found and no default specified ...")'); call goErr
- write (gol,'(" rcfile : ",a)') trim(rcfile%fname); call goErr
- write (gol,'(" key : ",a)') trim(key); call goErr
- TRACEBACK; status=1; return
- end if
- else if ( status == 0 ) then
- ! key found; set value:
- read (buffer,*,iostat=status) r
- if ( status /= 0 ) then
- write (gol,'("while reading real :")'); call goErr
- write (gol,'(" rcfile : ",a)') trim(rcfile%fname); call goErr
- write (gol,'(" key : ",a)') trim(key); call goErr
- write (gol,'(" value : ",a)') trim(buffer); call goErr
- TRACEBACK; status=1; return
- end if
- else
- ! some error ...
- TRACEBACK; status=1; return
- end if
-
- ! ok
- status = 0
- end subroutine ReadRc_r
-
- ! ***
-
- subroutine ReadRcs_r( rcfile, key, keys, r, status, default )
- use GO_Print, only : gol, goErr
- ! --- in/out ----------------------------
- type(TrcFile), intent(in) :: rcfile
- character(len=*), intent(in) :: key
- character(len=*), intent(in) :: keys(:)
- real, intent(out) :: r
- integer, intent(out) :: status
-
- real, intent(in), optional :: default
-
- ! --- const ----------------------------
-
- character(len=*), parameter :: rname = mname//'/ReadRcs_r'
- ! --- local -----------------------------
-
- logical :: found
- integer :: ikey
- real :: r_curr
- ! --- begin -----------------------------
-
- ! pessimistic assumption ...
- found = .false.
-
- ! loop over all key extensions:
- do ikey = 1, size(keys)
-
- ! try to read key;
- ! provide default to return without error if key is not found:
- call ReadRc( rcfile, trim(key)//'.'//trim(keys(ikey)), r_curr, status, default=0.0 )
- if ( status < 0 ) then
- ! not found; try next
- cycle
- else if ( status == 0 ) then
- ! found and value read:
- found = .true.
- r = r_curr
- else
- ! error ...
- TRACEBACK; status=1; return
- end if
-
- end do ! loop over keys
-
- ! not found ?
- if ( .not. found ) then
- ! default provided ?
- if ( present(default) ) then
- ! set to default:
- r = default
- else
- ! error ...
- write (gol,'("key(s) not found and no default specified ...")'); call goErr
- write (gol,'(" rcfile : ",a)') trim(rcfile%fname); call goErr
- do ikey = 1, size(keys)
- write (gol,'(" key : ",a,".",a)') trim(key), trim(keys(ikey)); call goErr
- end do
- TRACEBACK; status=1; return
- end if
- end if
-
- ! ok
- status = 0
- end subroutine ReadRcs_r
- ! ***
- subroutine ReadRc_r1( rcfile, key, r, status, default )
- use GO_Print, only : gol, goErr
- ! --- in/out ----------------------------
- type(TrcFile), intent(in) :: rcfile
- character(len=*), intent(in) :: key
- real, intent(out) :: r(:)
- integer, intent(out) :: status
-
- real, intent(in), optional :: default
-
- ! --- const ----------------------------
-
- character(len=*), parameter :: rname = mname//'/ReadRc_r1'
- ! --- local -----------------------------
- character(len=buflen) :: buffer
- integer :: k
- ! --- begin -----------------------------
- ! search key line in rcfile:
- call ReadRcItem( rcfile, key, buffer, status )
- if ( status < 0 ) then
- ! not found; set to default or leave with error:
- if ( present(default) ) then
- r = default
- status = -1 ; return
- else
- write (gol,'("key not found and no default specified ...")'); call goErr
- write (gol,'(" rcfile : ",a)') trim(rcfile%fname); call goErr
- write (gol,'(" key : ",a)') trim(key); call goErr
- TRACEBACK; status=1; return
- end if
- else if ( status == 0 ) then
- ! key found; set value:
- read (buffer,*,iostat=status) r
- if ( status /= 0 ) then
- write (gol,'("while reading real :")'); call goErr
- write (gol,'(" rcfile : ",a)') trim(rcfile%fname); call goErr
- write (gol,'(" key : ",a)') trim(key); call goErr
- write (gol,'(" value : ",a)') trim(buffer); call goErr
- TRACEBACK; status=1; return
- end if
- else
- ! some error ...
- TRACEBACK; status=1; return
- end if
-
- ! ok
- status = 0
- end subroutine ReadRc_r1
- ! ================================================================
- ! ===
- ! === logical
- ! ===
- ! ================================================================
-
-
- subroutine ReadRc_l( rcfile, key, l, status, default )
- use GO_Print, only : gol, goErr
- ! --- in/out ----------------------------
- type(TrcFile), intent(in) :: rcfile
- character(len=*), intent(in) :: key
- logical, intent(out) :: l
- integer, intent(out) :: status
-
- logical, intent(in), optional :: default
-
- ! --- const ----------------------------
-
- character(len=*), parameter :: rname = mname//'/ReadRc_l'
- ! --- local -----------------------------
- character(len=buflen) :: buffer
- ! --- begin -----------------------------
- ! search key line in rcfile:
- call ReadRcItem( rcfile, key, buffer, status )
- if ( status < 0 ) then
- ! not found; set to default or leave with warning:
- if ( present(default) ) then
- l = default
- status = -1 ; return
- else
- write (gol,'("key not found and no default specified ...")'); call goErr
- write (gol,'(" rcfile : ",a)') trim(rcfile%fname); call goErr
- write (gol,'(" key : ",a)') trim(key); call goErr
- TRACEBACK; status=1; return
- end if
- else if ( status == 0 ) then
- ! key found; set value:
- read (buffer,*,iostat=status) l
- if ( status /= 0 ) then
- write (gol,'("while reading logical :")'); call goErr
- write (gol,'(" rcfile : ",a)') trim(rcfile%fname); call goErr
- write (gol,'(" key : ",a)') trim(key); call goErr
- write (gol,'(" value : ",a)') trim(buffer); call goErr
- TRACEBACK; status=1; return
- end if
- else
- ! some error ...
- TRACEBACK; status=1; return
- end if
-
- ! ok
- status = 0
- end subroutine ReadRc_l
- ! ***
-
- subroutine ReadRcs_l( rcfile, key, keys, l, status, default )
- use GO_Print, only : gol, goErr
- ! --- in/out ----------------------------
- type(TrcFile), intent(in) :: rcfile
- character(len=*), intent(in) :: key
- character(len=*), intent(in) :: keys(:)
- logical, intent(out) :: l
- integer, intent(out) :: status
-
- logical, intent(in), optional :: default
-
- ! --- const ----------------------------
-
- character(len=*), parameter :: rname = mname//'/ReadRcs_l'
- ! --- local -----------------------------
-
- logical :: found
- integer :: ikey
- logical :: l_curr
- ! --- begin -----------------------------
-
- ! pessimistic assumption ...
- found = .false.
-
- ! loop over all key extensions:
- do ikey = 1, size(keys)
-
- ! try to read key;
- ! provide default to return without error if key is not found:
- call ReadRc( rcfile, trim(key)//'.'//trim(keys(ikey)), l_curr, status, default=.false. )
- if ( status < 0 ) then
- ! not found; try next
- cycle
- else if ( status == 0 ) then
- ! found and value read:
- found = .true.
- l = l_curr
- else
- ! error ...
- TRACEBACK; status=1; return
- end if
-
- end do ! loop over keys
-
- ! not found ?
- if ( .not. found ) then
- ! default provided ?
- if ( present(default) ) then
- ! set to default and leave with warning:
- l = default
- status = -1 ; return
- else
- ! error ...
- write (gol,'("key(s) not found and no default specified ...")'); call goErr
- write (gol,'(" rcfile : ",a)') trim(rcfile%fname); call goErr
- do ikey = 1, size(keys)
- write (gol,'(" key : ",a,".",a)') trim(key), trim(keys(ikey)); call goErr
- end do
- TRACEBACK; status=1; return
- end if
- end if
-
- ! ok
- status = 0
- end subroutine ReadRcs_l
- ! ================================================================
- ! ===
- ! === character string
- ! ===
- ! ================================================================
- subroutine ReadRc_s( rcfile, key, s, status, default )
-
- use GO_Print, only : gol, goErr
- ! --- in/out ----------------------------
- type(TrcFile), intent(in) :: rcfile
- character(len=*), intent(in) :: key
- character(len=*), intent(out) :: s
- integer, intent(out) :: status
-
- character(len=*), intent(in), optional :: default
-
- ! --- const ----------------------------
-
- character(len=*), parameter :: rname = mname//'/ReadRc_s'
- ! --- local -----------------------------
- character(len=buflen) :: buffer
- ! --- begin -----------------------------
- ! search key line in rcfile:
- call ReadRcItem( rcfile, key, buffer, status )
- if ( status < 0 ) then
- ! not found; set to default or leave with error:
- if ( present(default) ) then
- s = trim(default)
- status = -1 ; return
- else
- write (gol,'("key not found and no default specified ...")'); call goErr
- write (gol,'(" rcfile : ",a)') trim(rcfile%fname); call goErr
- write (gol,'(" key : ",a)') trim(key); call goErr
- TRACEBACK; status=1; return
- end if
- else if ( status == 0 ) then
- ! key found; set value:
- s = trim(buffer)
- else
- ! some error ...
- TRACEBACK; status=1; return
- end if
-
- ! ok
- status = 0
- end subroutine ReadRc_s
- ! ***
-
- subroutine ReadRcs_s( rcfile, key, keys, s, status, default )
- use GO_Print, only : gol, goErr
- ! --- in/out ----------------------------
- type(TrcFile), intent(in) :: rcfile
- character(len=*), intent(in) :: key
- character(len=*), intent(in) :: keys(:)
- character(len=*), intent(out) :: s
- integer, intent(out) :: status
-
- character(len=*), intent(in), optional :: default
-
- ! --- const ----------------------------
-
- character(len=*), parameter :: rname = mname//'/ReadRcs_l'
- ! --- local -----------------------------
-
- logical :: found
- integer :: ikey
- character(len=buflen) :: s_curr
- ! --- begin -----------------------------
-
- ! pessimistic assumption ...
- found = .false.
-
- ! loop over all key extensions:
- do ikey = 1, size(keys)
-
- ! try to read key;
- ! provide default to return without error if key is not found:
- call ReadRc( rcfile, trim(key)//'.'//trim(keys(ikey)), s_curr, status, default='-' )
- if ( status < 0 ) then
- ! not found; try next
- cycle
- else if ( status == 0 ) then
- ! found and value read:
- found = .true.
- s = trim(s_curr)
- else
- ! error ...
- TRACEBACK; status=1; return
- end if
-
- end do ! loop over keys
-
- ! not found ?
- if ( .not. found ) then
- ! default provided ?
- if ( present(default) ) then
- ! set to default:
- s = default
- ! warning status
- status=-1; return
- else
- ! error ...
- write (gol,'("key(s) not found and no default specified ...")'); call goErr
- write (gol,'(" rcfile : ",a)') trim(rcfile%fname); call goErr
- do ikey = 1, size(keys)
- write (gol,'(" key : ",a,".",a)') trim(key), trim(keys(ikey)); call goErr
- end do
- TRACEBACK; status=1; return
- end if
- end if
-
- ! ok
- status = 0
- end subroutine ReadRcs_s
- end module GO_Rc
|