1c
2c
3c     ###################################################
4c     ##  COPYRIGHT (C)  1990  by  Jay William Ponder  ##
5c     ##              All Rights Reserved              ##
6c     ###################################################
7c
8c     ##########################################################
9c     ##                                                      ##
10c     ##  subroutine gettext  --  extract text from a string  ##
11c     ##                                                      ##
12c     ##########################################################
13c
14c
15c     "gettext" searches an input string for the first string of
16c     non-blank characters; the region from a non-blank character
17c     to the first space or tab is returned as "text"; if the
18c     actual text is too long, only the first part is returned
19c
20c     variables and parameters:
21c
22c     string    input character string to be searched
23c     text      output with the first text string found
24c     next      input with first position of search string;
25c                 output with the position following text
26c
27c
28      subroutine gettext (string,text,next)
29      use ascii
30      implicit none
31      integer i,j
32      integer len,length
33      integer size,next
34      integer first,last
35      integer code,extent
36      integer initial,final
37      character*(*) string
38      character*(*) text
39c
40c
41c     get the length of input string and output text
42c
43      length = len(string(next:))
44      size = len(text)
45c
46c     search the string for the first non-blank character
47c
48      first = next
49      last = 0
50      initial = next
51      final = next + length - 1
52      do i = initial, final
53         code = ichar(string(i:i))
54         if (code.ne.space .and. code.ne.tab) then
55            first = i
56            do j = i+1, final
57               code = ichar(string(j:j))
58               if (code.eq.space .or. code.eq.tab) then
59                  last = j - 1
60                  next = j
61                  goto 10
62               end if
63            end do
64            last = final
65            next = last + 1
66         end if
67      end do
68   10 continue
69c
70c     trim the actual text if it is too long to return
71c
72      extent = next - first
73      final = first + size - 1
74      if (extent .gt. size)  last = final
75c
76c     transfer the text into the return string
77c
78      j = 0
79      do i = first, last
80         j = j + 1
81         text(j:j) = string(i:i)
82      end do
83      do i = next, final
84         j = j + 1
85         text(j:j) = ' '
86      end do
87      return
88      end
89