1 C $Date: 1994/10/12 17:24:21 $
6 logical function find_arg(ipos,line,errflag)
12 character*1 empty /' '/,equal /'='/
14 * This function returns .TRUE., if an argument follows keyword keywd; if so
15 * IPOS will point to the first non-blank character of the argument. Returns
16 * .FALSE., if no argument follows the keyword; in this case IPOS points
17 * to the first non-blank character of the next keyword.
18 do while (line(ipos:ipos) .eq. empty .and. ipos.le.maxlen)
22 if (line(ipos:ipos).eq.equal) then
25 do while (line(ipos:ipos) .eq. empty .and. ipos.le.maxlen)
28 if (ipos.gt.maxlen) errflag=.true.
34 logical function find_group(iunit,jout,key1)
39 character*80 karta,ucase
46 do while (index(ucase(karta),key1(1:ll)).eq.0.or.lcom(1,karta))
47 read (iunit,'(a)',end=10) karta
49 write (jout,'(2a)') '> ',karta(1:78)
55 logical function iblnk(charc)
60 iblnk = (n.eq.9) .or. (n.eq.10) .or. (charc.eq. ' ')
63 integer function ilen(string)
69 1 if ( ilen .gt. 0 ) then
70 if ( iblnk( string(ilen:ilen) ) ) then
77 integer function in_keywd_set(nkey,ikey,narg,keywd,keywdset)
80 character*16 keywd,keywdset(1:nkey,0:nkey)
84 if (ucase(keywd).eq.keywdset(i,ikey)) then
90 * No match to the allowed set of keywords if this point is reached.
94 character*(*) function lcase(string)
105 if (string(k+1:) .ne. ' ') then
109 idiff = ichar('a') - ichar('A')
113 if (lge(c,'A') .and. lle(c,'Z')) then
114 lcase(i:i) = char(ichar(c) + idiff)
119 logical function lcom(ipos,karta)
123 character koment(2) /'!','#'/
126 if (karta(ipos:ipos).eq.koment(i)) lcom=.true.
130 logical function lower_case(ch)
132 lower_case=(ch.ge.'a' .and. ch.le.'z')
135 subroutine mykey(line,keywd,ipos,blankline,errflag)
137 * This subroutine seeks a non-empty substring keywd in the string LINE.
138 * The substring begins with the first character different from blank and
139 * "=" encountered right to the pointer IPOS (inclusively) and terminates
140 * at the character left to the first blank or "=". When the subroutine is
141 * exited, the pointer IPOS is moved to the position of the terminator in LINE.
142 * The logical variable BLANKLINE is set at .TRUE., if LINE(IPOS:) contains
143 * only separators or the maximum length of the data line (80) has been reached.
144 * The logical variable ERRFLAG is set at .TRUE. if the string
145 * consists only from a "=".
147 parameter (maxlen=80)
148 character*1 empty /' '/,equal /'='/,comma /','/
151 logical blankline,errflag,lcom
152 integer ipos,istart,iend
154 do while (line(ipos:ipos).eq.empty .and. (ipos.le.maxlen))
157 if (ipos.gt.maxlen .or. lcom(ipos,line) ) then
158 * At this point the rest of the input line turned out to contain only blanks
159 * or to be commented out.
165 * Checks whether the current char is a separator.
166 do while (line(ipos:ipos).ne.empty .and. line(ipos:ipos).ne.equal
167 & .and. line(ipos:ipos).ne.comma .and. ipos.le.maxlen)
171 * Error flag set to .true., if the length of the keyword was found less than 1.
172 if (iend.lt.istart) then
176 keywd=line(istart:iend)
179 subroutine numstr(inum,numm)
181 integer inum,inum1,inum2,inumm
182 character*10 huj /'0123456789'/
188 numm(3:3)=huj(inum2+1:inum2+1)
192 numm(2:2)=huj(inum2+1:inum2+1)
196 numm(1:1)=huj(inum2+1:inum2+1)
199 character*(*) function ucase(string)
210 if (string(k+1:) .ne. ' ') then
214 idiff = ichar('a') - ichar('A')
218 if (lge(c,'a') .and. lle(c,'z')) then
219 ucase(i:i) = char(ichar(c) - idiff)