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