1      integer function getlin(ieq)
2      character*137 line
3      common /rdwr/   iun1,iun2,iun3,iun4,iun5
4      common /curlin/ line
5      common /mflin/  linmf
6
7      getlin = 1
8
9      call nxtlin(line,jstat)
10      if (jstat.eq.1.or.jstat.eq.2) goto 100
11
12      linmf = linmf + 1
13      do i=1,137
14         if (ichar(line(i:i)).eq.9) line(i:i) = ' '
15      end do
16
17      if (ieq.eq.1.or.ieq.eq.2) then
18         do i=1,137
19            if (ichar(line(i:i)).eq.61) line(i:i) = ' '
20         end do
21      endif
22
23      if (ieq.eq.2) then
24         do i=1,137
25            ii = ichar(line(i:i))
26            if (ii.eq.40.or.ii.eq.41.or.ii.eq.34.or.ii.eq.39)
27     &         line(i:i) = ' '
28         end do
29      endif
30
31      if (ieq.eq.3) then
32         do while (.true.)
33            i1 = index(line,'(')
34            i2 = index(line,')')
35            if (i1.gt.0.and.i2.gt.0) then
36               line = line(1:i1-1)//line(i2+1:)
37            else
38               return
39            endif
40         end do
41      endif
42
43      return
44100   getlin = 0
45      return
46      end
47
48      subroutine setlin(str,ic)
49      character*(*) str
50      character*137 line
51      common /curlin/ line
52
53      line = str
54      if (ic.ne.0) then
55         do i=1,linlen(str)
56            if (ichar(line(i:i)).eq.ic) line(i:i) = ' '
57         end do
58      endif
59
60      return
61      end
62
63      integer function nxtwrd(string,strlen,itype,rtype)
64c
65c      string           nxtwrd = 1
66c      integer          nxtwrd = 2
67c      real             nxtwrd = 3
68c      no word          nxtwrd = 0
69c
70      character*(*) string
71      integer itype,strlen
72      double precision rtype
73      double precision reada
74      logical chkstr
75      character*137 line
76      common /curlin/ line
77
78      nxtwrd = 0
79
80      llen = linlen(line)
81      if (llen.eq.0) return
82
83      do while (line(1:1).eq.' ')
84          line = line(2:)
85      end do
86
87      iend = index(line,' ')
88      if (iend.eq.0) then
89         iend = llen
90      else
91         iend = iend - 1
92      endif
93      if (chkstr(line,iend)) then
94           nxtwrd = 1
95           string = line(1:iend)
96           strlen = iend
97      elseif (index(line(1:iend),'.').ne.0) then
98           nxtwrd = 3
99           rtype = reada(line,1,iend)
100      else
101           nxtwrd = 2
102           itype = reada(line,1,iend)
103      endif
104
105      line = line(iend+1:)
106
107      return
108      end
109
110      integer function nxtwrz(string,strlen,itype,rtype)
111c
112c      string           nxtwrd = 1
113c      integer          nxtwrd = 2
114c      real             nxtwrd = 3
115c      n*int            nxtwrd = 4
116c      no word          nxtwrd = 0
117c
118      character*(*) string
119      integer itype,strlen
120      double precision rtype
121      double precision reada
122      logical chkstd
123      character*137 line
124      common /curlin/ line
125
126      nxtwrz = 0
127
128      llen = linlen(line)
129      if (llen.eq.0) return
130
131      do while (line(1:1).eq.' ')
132          line = line(2:)
133      end do
134
135      iend = index(line,' ')
136      if (iend.eq.0) then
137         iend = llen
138      else
139         iend = iend - 1
140      endif
141      if (chkstd(line,iend)) then
142           nxtwrz = 1
143           string = line(1:iend)
144           strlen = iend
145      elseif (index(line(1:iend),'.').ne.0) then
146           if (index(line(1:iend),'*').ne.0) then
147              ied = index(line,'*')
148              if (ied.eq.0) then
149                 ied = llen
150              else
151                 ied = ied - 1
152              endif
153              itype = reada(line,1,ied)
154              nxtwrz = 4
155           else
156              nxtwrz = 3
157              rtype = reada(line,1,iend)
158           endif
159      else
160           nxtwrz = 2
161           itype = reada(line,1,iend)
162      endif
163
164      line = line(iend+1:)
165
166      return
167      end
168
169      integer function nxtwrx(string,strlen,itype,rtype)
170c
171c      string           nxtwrd = 1
172c      integer          nxtwrd = 2
173c      real             nxtwrd = 3
174c      no word          nxtwrd = 0
175c
176      character*(*) string
177      integer itype,strlen
178      double precision rtype
179      double precision reada
180      logical chkstr
181      character*137 line
182      common /curlin/ line
183
184      nxtwrx = 0
185
186      nine  = ichar('9')
187      izero = ichar('0')
188
189      llen = linlen(line)
190      if (llen.eq.0) return
191
192      do while (line(1:1).eq.' ')
193          line = line(2:)
194      end do
195
196      if (llen.gt.3) then
197          do i=1,llen-2
198              ii = ichar(line(i+1:i+1))
199              if (line(i:i).eq.'('.and.line(i+2:i+2).eq.')'.and.
200     &           (ii.ge.izero.and.ii.le.nine)) then
201                 line = line(i-1:)//line(i+3:)
202              endif
203          end do
204      endif
205
206      llen = linlen(line)
207      if (llen.eq.0) return
208
209      iend = index(line,' ')
210      if (iend.eq.0) then
211         iend = llen
212      else
213         iend = iend - 1
214      endif
215
216      if (chkstr(line,iend)) then
217           nxtwrx = 1
218           string = line(1:iend)
219           strlen = iend
220      elseif (index(line(1:iend),'.').ne.0) then
221           nxtwrx = 3
222           rtype = reada(line,1,iend)
223      else
224           nxtwrx = 2
225           itype = reada(line,1,iend)
226      endif
227
228      line = line(iend+1:)
229
230      return
231      end
232
233      logical function chkstr(line,iend)
234      character*(*) line
235      chkstr = .false.
236
237      ie    = ichar('e')
238      iee   = ichar('E')
239      id    = ichar('d')
240      idd   = ichar('D')
241      nine  = ichar('9')
242      izero = ichar('0')
243      minus = ichar('-')
244      iplus = ichar('+')
245      idot  = ichar('.')
246      icomma = ichar(',')
247      islash  = ichar('/')
248
249      ihase = 0
250      idig = 0
251      do i=1,iend
252         n = ichar(line(i:i))
253         if ((n.eq.ie.or.n.eq.iee.or.n.eq.id.or.n.eq.idd)
254     &      .and.ihase.eq.0.and.idig.eq.1) then
255             n = izero
256             ihase = 1
257         endif
258         if (n.lt.iplus.or.n.gt.nine.or.n.eq.islash
259     &       .or.n.eq.icomma) goto 100
260         idig = 1
261      end do
262
263      n = ichar(line(1:1))
264      n2 = ichar(line(2:2))
265      if (iend.eq.1) then
266         if (n.eq.minus) goto 100
267         if (n.eq.iplus) goto 100
268         if (n.eq.ie.or.n.eq.iee) goto 100
269         if (n.eq.id.or.n.eq.idd) goto 100
270      elseif (iend.gt.1) then
271         if (n.eq.minus.and.n2.eq.minus) goto 100
272      endif
273
274      return
275100   chkstr = .true.
276      return
277      end
278
279      logical function chkstd(line,iend)
280      character*(*) line
281      chkstd = .false.
282
283      ie    = ichar('e')
284      iee   = ichar('E')
285      id    = ichar('d')
286      idd   = ichar('D')
287      nine  = ichar('9')
288      izero = ichar('0')
289      minus = ichar('-')
290      iplus = ichar('+')
291      idot  = ichar('.')
292      icomma = ichar(',')
293      islash = ichar('/')
294      istar  = ichar('*')
295
296      ihase = 0
297      idig = 0
298      do i=1,iend
299         n = ichar(line(i:i))
300         if ((n.eq.ie.or.n.eq.iee.or.n.eq.id.or.n.eq.idd)
301     &      .and.ihase.eq.0.and.idig.eq.1) then
302             n = izero
303             ihase = 1
304         endif
305         if ((n.lt.iplus.or.n.gt.nine.or.n.eq.islash
306     &       .or.n.eq.icomma).and.n.ne.istar) goto 100
307         idig = 1
308      end do
309
310      n = ichar(line(1:1))
311      n2 = ichar(line(2:2))
312      if (iend.eq.1) then
313         if (n.eq.minus) goto 100
314         if (n.eq.iplus) goto 100
315         if (n.eq.ie.or.n.eq.iee) goto 100
316         if (n.eq.id.or.n.eq.idd) goto 100
317      elseif (iend.gt.1) then
318         if (n.eq.minus.and.n2.eq.minus) goto 100
319      endif
320
321      return
322100   chkstd = .true.
323      return
324      end
325
326      integer function linlen(line)
327      character*(*) line
328      integer i,n
329
330      linlen = 0
331
332      do i=len(line),1,-1
333         n = ichar(line(i:i))
334         if (n.gt.32.and.n.le.126) goto 100
335      end do
336
337      return
338100   linlen = i
339      return
340      end
341
342      logical function dat3ln(lin)
343      integer i,itype,ktype,nstr
344      double precision rtype
345      character*(*) lin
346      character*137 str
347      character*137 line
348      common /curlin/ line
349
350      dat3ln = .true.
351
352      line = lin
353
354      do i=1,3
355         ktype = nxtwrd(str,nstr,itype,rtype)
356         if (ktype.ne.3.and.ktype.ne.2) goto 100
357      end do
358
359      return
360100   dat3ln = .false.
361      return
362      end
363
364      logical function datlin(line)
365      character*(*) line
366
367      datlin = .true.
368
369      do i=1,linlen(line)
370         n = ichar(line(i:i))
371         if ((n.lt.43.or.n.gt.57).and.n.ne.32.and.n.ne.68.
372     &       and.n.ne.100.and.n.ne.69.and.n.ne.101) goto 100
373      end do
374
375      return
376100   datlin = .false.
377      return
378      end
379
380      logical function gnreal(r,n,doget)
381      implicit double precision (a-h,o-z)
382      character*137 line,str
383      common /curlin/ line
384      integer getlin
385      logical doget
386      dimension r(*)
387
388      gnreal = .true.
389
390      if (doget) then
391         if (getlin(0).ne.1) gnreal = .false.
392      endif
393
394      if (gnreal) then
395          do i=1,n
396             ktype = nxtwrd(str,nstr,itype,rtype)
397             if (ktype.eq.3) then
398                r(i) = rtype
399             elseif (ktype.eq.2) then
400                r(i) = dble(itype)
401             else
402                gnreal = .false.
403             endif
404          end do
405      endif
406
407      return
408      end
409
410      logical function gnint(iarr,n,doget)
411      implicit double precision (a-h,o-z)
412      character*137 line,str
413      common /curlin/ line
414      integer getlin
415      logical doget
416      dimension iarr(*)
417
418      gnint = .true.
419
420      if (doget) then
421         if (getlin(0).ne.1) gnint = .false.
422      endif
423
424
425      if (gnint) then
426          do i=1,n
427             ktype = nxtwrd(str,nstr,itype,rtype)
428             if (ktype.eq.2) then
429                iarr(i) = itype
430             else
431                gnint = .false.
432             endif
433          end do
434      endif
435
436      return
437      end
438
439      subroutine lsparm(str,l)
440      character*(*) str
441
442      l = len(str)
443      do i=1,l
444         if (str(i:i).ne.' ') goto 10
445      end do
44610    str = str(i:)
447      l = linlen(str)
448      return
449      end
450
451      subroutine spatrm(str,l)
452      character*(*) str
453
454      j = 1
455      l = len(str)
456      do while (j.le.l)
457         if (str(j:j).eq.' ') then
458           if (l.eq.1) then
459              return
460           else
461              if (j.ne.l) then
462                 if (j.eq.1) then
463                    str(1:l-1) = str(2:l)
464                    str(l:l) = ' '
465                 else
466c                    str(j:l-1) = str(j:j-1)//str(j+1:l)
467                    str(j:l-1) = str(j+1:l)
468                    str(l:l) = ' '
469                 endif
470              endif
471              l = l - 1
472           endif
473         else
474           j = j + 1
475         endif
476      end do
477
478c      if (l.lt.len(str)) str(l+1:l+1) = char(0)
479
480      return
481      end
482
483      integer function krnd(r)
484      implicit double precision (a-h,p-z),integer (i-n),logical (o)
485
486      krnd = int(r)
487      if (r-dfloat(krnd).ge.0.5d0) krnd = krnd + 1
488
489      return
490      end
491
492      subroutine rmnull(line)
493      implicit double precision (a-h,p-z),integer (i-n),logical (o)
494      character*137 line
495
496      ii = 0
497      do while (ii.le.137)
498         ii = ii + 1
499         jj = ichar(line(ii:ii))
500         if (jj.eq.0) then
501            do kk=ii,136
502               line(kk:kk) = line(kk+1:kk+1)
503            end do
504            if (ii.eq.138) return
505            ii = ii - 1
506         endif
507         if (jj.eq.10.or.jj.eq.13) return
508      end do
509
510      return
511      end
512
513      subroutine rwfile()
514      implicit double precision (a-h,p-z),integer (i-n),logical (o)
515      common /rdwr/   iun1,iun2,iun3,iun4,iun5
516
517      rewind iun2
518
519      return
520      end
521
522      subroutine bcfile()
523      implicit double precision (a-h,p-z),integer (i-n),logical (o)
524      common /rdwr/   iun1,iun2,iun3,iun4,iun5
525
526      backspace iun2
527
528      return
529      end
530
531      subroutine nxline(line,istat)
532      implicit double precision (a-h,p-z),integer (i-n),logical (o)
533      character*137 line
534      common /rdwr/   iun1,iun2,iun3,iun4,iun5
535
536      istat = 0
537
538      read(iun2,'(a)',end=100,err=200) line
539
540      return
541100   istat = 1
542      return
543200   istat = 2
544      return
545      end
546
547