275 lines
8.7 KiB
Fortran
275 lines
8.7 KiB
Fortran
module keyread_mod
|
|
contains
|
|
|
|
subroutine keyread(keylist,infile,keynum,idat,ddat,cdat,datpos,
|
|
> klen,llen,clen,linenum,maxdat)
|
|
use long_keyread_mod,only:long_intkey,long_realkey,long_strkey
|
|
use strings_mod,only:int2string,dble2string
|
|
implicit none
|
|
! Read all keys from KEYLIST from INFILE and write their associated
|
|
! data to the corresponding data block. Memory management is
|
|
! handled by DATPOS.
|
|
!
|
|
! keylist: Registry of keys containing the name of the key
|
|
! and it's type information.
|
|
! keylist(N,1): keyname. It should be in all-caps.
|
|
! keylist(N,2): type string of the form "X#"
|
|
!
|
|
! Note: Key 1 (keylist(1,1)) has the special property that all
|
|
! lines of the input file after it's first occurence will be
|
|
! ignored. This allows for long input files holding non-key
|
|
! information.
|
|
!
|
|
! typestring syntax:
|
|
! X should be I (Integer), +I (Int >= 0), D (double precision),
|
|
! C (character string), +D (real >= 0.0d0)
|
|
! or E (checks whether key exists).
|
|
! X! (e.g. +I!, D!,..) makes a key non-optional.
|
|
! E!, while absurd, is a valid option.
|
|
! # should be either N (meaning variable length) or an integer >0.
|
|
! it encodes the expected number of read values
|
|
!
|
|
! note: the E-type has no associated *dat-array, instead
|
|
! datpos(2,N) is either -1 or it's last occurence in infile,
|
|
! depending on whether the key was found. Furthermore,
|
|
! E-type keys accept no arguments.
|
|
!
|
|
! *dat: data arrays for respective items
|
|
! klen: length of key/typestring
|
|
! llen: line length of infile
|
|
! clen: length of read strings
|
|
! keynum: number of keys
|
|
! linenum: number of lines the file has
|
|
! maxdat: maximum number of total input values read
|
|
! infile: input file
|
|
! datpos: integer array assigning read values to the keys
|
|
! datpos(1,N): internalized type (0: I, 1: +I, 2: D, 3: +D,
|
|
! 4: C, 5: E)
|
|
! datpos(2,N): starting pos. in respective data array
|
|
! datpos(3,N): length of data block
|
|
!
|
|
|
|
!? WARNING: *dat() MAY BE WRITTEN BEYOND THEIR LENGTH FOR BAD DIMENSIONS.
|
|
!? CATCH THIS!
|
|
|
|
integer klen, llen, clen
|
|
integer keynum, linenum, maxdat
|
|
character(len=klen) keylist(2,keynum)
|
|
character(len=llen) infile(linenum)
|
|
integer datpos(3,maxdat)
|
|
|
|
integer idat(maxdat)
|
|
double precision ddat(maxdat)
|
|
character(len=clen) cdat(maxdat)
|
|
character(len=klen) key
|
|
character(len=64) errmsg
|
|
|
|
integer intype,inlen,readlen
|
|
integer cstart,istart,dstart
|
|
integer key_end
|
|
integer datnum,inpos,datlen
|
|
integer file_stop
|
|
logical optional2
|
|
|
|
integer j,k
|
|
|
|
cstart=1
|
|
istart=1
|
|
dstart=1
|
|
datnum=0
|
|
|
|
file_stop=linenum
|
|
key=keylist(1,1)
|
|
key_end=len_trim(key)
|
|
if (key_end.ne.0) then
|
|
do k=1,linenum
|
|
if (infile(k)(1:key_end).eq.trim(key)) then
|
|
file_stop=k
|
|
exit
|
|
endif
|
|
enddo
|
|
endif
|
|
|
|
do j=1,keynum
|
|
key=keylist(1,j)
|
|
|
|
! get information needed to read key
|
|
call get_key_kind(keylist(:,j),intype,optional2,inlen,klen)
|
|
datpos(1,j)=intype
|
|
key_end=len_trim(key)
|
|
|
|
! find last invocation of key (if present)
|
|
inpos=0
|
|
do k=1,file_stop
|
|
if (infile(k)(1:key_end).eq.trim(key)) then
|
|
inpos=k
|
|
endif
|
|
enddo
|
|
|
|
if (inpos.eq.0) then
|
|
if (.not.optional2) then
|
|
errmsg='MISSING, NON-OPTIONAL KEY'
|
|
call signal_key_error(key,errmsg,klen)
|
|
endif
|
|
datpos(2,j)=-1
|
|
datpos(3,j)=0
|
|
cycle
|
|
endif
|
|
|
|
! read from last occurence of key
|
|
readlen=0
|
|
if (intype.le.1) then
|
|
datlen=maxdat-istart+1
|
|
call long_intkey(infile,inpos,key_end,
|
|
> idat,istart,readlen,llen,maxdat,linenum)
|
|
else if (intype.le.3) then
|
|
datlen=maxdat-dstart+1
|
|
call long_realkey(infile,inpos,key_end,
|
|
> ddat,dstart,readlen,llen,maxdat,linenum)
|
|
else if (intype.eq.4) then
|
|
call long_strkey(infile,inpos,key_end,
|
|
> cdat,cstart,readlen,llen,maxdat,linenum,clen)
|
|
else if (intype.eq.5) then
|
|
! since datpos already encodes whether the key was found,
|
|
! there is no need to save anything
|
|
readlen=0
|
|
else
|
|
write(6,*) 'ERROR: ENCOUNTERED FAULTY TYPE SPEC.'
|
|
stop 1
|
|
endif
|
|
|
|
! check validity of input length
|
|
if (inlen.eq.-1) then
|
|
inlen=readlen
|
|
else if (inlen.ne.readlen) then
|
|
errmsg='WRONG NUMBER OF ARGUMENTS'
|
|
call signal_key_error(key,errmsg,klen)
|
|
endif
|
|
|
|
! check sign of +X types
|
|
if (intype.eq.1) then
|
|
do k=1,inlen
|
|
if (idat(istart-1+k).lt.0) then
|
|
errmsg='UNEXPECTED NEGATIVE INTEGER: '
|
|
> // trim(int2string(idat(istart-1+k)))
|
|
call signal_key_error(key,errmsg,klen)
|
|
endif
|
|
enddo
|
|
else if (intype.eq.3) then
|
|
do k=1,inlen
|
|
if (ddat(dstart-1+k).lt.0.0d0) then
|
|
errmsg='UNEXPECTED NEGATIVE REAL: '
|
|
> // trim(dble2string(ddat(dstart-1+k)))
|
|
call signal_key_error(key,errmsg,klen)
|
|
endif
|
|
enddo
|
|
endif
|
|
|
|
if (intype.le.1) then
|
|
datpos(2,j)=istart
|
|
istart=istart+inlen
|
|
else if (intype.le.3) then
|
|
datpos(2,j)=dstart
|
|
dstart=dstart+inlen
|
|
else if (intype.eq.4) then
|
|
datpos(2,j)=cstart
|
|
dstart=cstart+inlen
|
|
else if (intype.eq.5) then
|
|
! remember where you last found the key in infile
|
|
datpos(2,j)=inpos
|
|
endif
|
|
|
|
datpos(3,j)=inlen
|
|
|
|
enddo
|
|
end subroutine keyread
|
|
|
|
|
|
subroutine get_key_kind(kentry,dattype,optional2,datlen,klen)
|
|
use strings_mod,only:trimnum,nth_word
|
|
implicit none
|
|
! Read typestring from a keylist entry KENTRY and extract the
|
|
! specific type and expected length of KEYs input.
|
|
!
|
|
! dattype: type of the data, encoded as int
|
|
! optional: true if key does not need to be present
|
|
! datlen: number of values expected
|
|
! klen: length of keys
|
|
|
|
include 'typedef.incl'
|
|
|
|
integer klen
|
|
integer dattype,datlen
|
|
character(len=klen) kentry(2)
|
|
logical optional2
|
|
|
|
character(len=klen) typestr,key,tmp,numstr
|
|
character(len=64) errmsg
|
|
integer strpos,typelen
|
|
|
|
integer j
|
|
|
|
key=kentry(1)
|
|
typestr=kentry(2)
|
|
strpos=0
|
|
dattype=-1
|
|
! check type declaration against defined types in typedef.incl
|
|
do j=1,typenum
|
|
typelen=len_trim(types(j))
|
|
if (typestr(1:typelen).eq.trim(types(j))) then
|
|
dattype=j-1
|
|
strpos=typelen+1
|
|
exit
|
|
endif
|
|
enddo
|
|
|
|
if (dattype.eq.-1) then
|
|
errmsg='INVALID TYPE SPEC: '//'"'//typestr(1:maxtypelen)//'"'
|
|
call signal_key_error(key,errmsg,klen)
|
|
endif
|
|
|
|
! Any type followed by ! makes the card non-optional, crashing the
|
|
! program if it is missing.
|
|
optional2=(typestr(strpos:strpos).ne.'!')
|
|
if (.not.optional2) then
|
|
strpos=strpos+1
|
|
endif
|
|
|
|
if (dattype.eq.5) then
|
|
! since only the key's presence is checked, there is no need to
|
|
! read beyond the key
|
|
datlen=0
|
|
else if (typestr(strpos:strpos).eq.'N') then
|
|
datlen=-1
|
|
else
|
|
call trimnum(typestr,tmp,klen)
|
|
call nth_word(tmp,numstr,1,klen)
|
|
! crash gracefully if the expected number of values is neither
|
|
! int nor "N" (hackey version, but i can't think of a cleaner one)
|
|
do j=1,1
|
|
read(numstr,*,err=600,end=600) datlen
|
|
cycle
|
|
600 errmsg='CORRUPTED NUMBER OF VALUES: '
|
|
> //'"'//trim(typestr)//'"'
|
|
call signal_key_error(key,errmsg,klen)
|
|
enddo
|
|
if (datlen.le.0) then
|
|
errmsg='INVALID TYPE SPEC: '//'"'//trim(typestr)//'"'
|
|
call signal_key_error(key,errmsg,klen)
|
|
endif
|
|
endif
|
|
|
|
end subroutine get_key_kind
|
|
|
|
|
|
subroutine signal_key_error(key,msg,klen)
|
|
implicit none
|
|
integer klen
|
|
character(len=klen) key
|
|
character(len=*) msg
|
|
write(6,'(A)') 'ERROR: ' // trim(key) // ' ' // trim(msg)
|
|
stop 1
|
|
end subroutine signal_key_error
|
|
|
|
end module
|