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