1 gaskelld 1.1 ******************************* STRINGLIB.FOR **********************************
  2              C+______________________________________________________________________________
  3              !
  4              !Facility: STRINGLIB
  5              !Version:  2.1
  6              !
  7              !Purpose: A Library of string manipulation routines. See entry points for
  8              !         details.
  9              !
 10              !Entry points:
 11              !
 12              !  last_char(string)
 13              !  strip(cmd,p1)
 14              !  rd_logical(cmd,l)
 15              !  rd_int(cmd,i)
 16              !  rd_real(cmd,x)
 17              !  rd_hex(cmd,i)
 18              !
 19              !Author: David Potterveld - May 1985
 20              !
 21              !Modification History:
 22 gaskelld 1.1 !
 23              !  Jan-13-1990 (DHP) Added routine RD_HEX.
 24              !  Mar-24-1992 (DHP) Conversion for UNIX F77 compatibility. STRIP, and RD_xxxx
 25              !		routines are now logical functions. VAX RTL routines replaced.
 26              !  Mar-25-1992 (DHP) Added routine RD_LOGICAL.
 27              !  Aug-24-1993 (DHP) Fixed bug in STRIP.
 28              C-______________________________________________________________________________
 29              
 30              !###############################################################################
 31              
 32              	integer*4 function last_char(string)
 33              C+______________________________________________________________________________
 34              !
 35              ! LAST_CHAR - Return the position of the last character in the string which
 36              ! is neither a space or a tab. Returns zero for null or empty strings.
 37              C-______________________________________________________________________________
 38              
 39              	implicit none
 40              	integer*4 i
 41              	character*(*) string
 42              	character*1 sp/' '/
 43 gaskelld 1.1 	character*1 tab/'	'/
 44              
 45              	save
 46              
 47              C ============================= Executable Code ================================
 48              
 49              	last_char = 0
 50              	do i = 1,len(string)
 51              	   if (string(i:i).ne.sp.and.string(i:i).ne.tab) last_char = i
 52              	enddo
 53              
 54              	return
 55              	end
 56              
 57              !###############################################################################
 58              
 59              	logical function strip(cmd,p1)
 60              C+______________________________________________________________________________
 61              !
 62              ! STRIP - strip space and tab separated substrings out of a string.
 63              !
 64 gaskelld 1.1 ! Operation:
 65              !   1 - Strip off leading separators (blanks and tabs) from CMD.
 66              !   2 - If no non-separator characters encountered, return .FALSE.
 67              !   3 - PUT all characters up to next separator into P1.
 68              !   4 - Strip off all characters including separators from CMD until
 69              !       either the next word is positioned at the beginning of CMD, or
 70              !       the end of the orginal CMD is reached.
 71              !   5 - Return .TRUE.
 72              C-______________________________________________________________________________
 73              
 74              	implicit none
 75              	integer*4 char_cnt,len_cmd,len_word,len_p1
 76              	integer*4 pos_of_sp,pos_of_sep,pos_of_tab
 77              	character*(*) cmd,p1
 78              	character*1 c1,sp,tab
 79              	data	sp/' '/
 80              	data	tab/'	'/
 81              	logical more,stripped
 82              	save
 83              
 84              C ============================= Executable Code ================================
 85 gaskelld 1.1 
 86              	char_cnt = 0				!count processed characters
 87              	len_cmd = len(cmd)			!length of command string
 88              	len_p1 = len(p1)			!length of substring
 89              	more = .true.				!more work to do
 90              	stripped = .false.			!haven't stripped word
 91              
 92              	do while (more.and.char_cnt.lt.len_cmd)
 93              	   c1 = cmd(1:1)			!get leading character
 94              	   if (c1.eq.sp.or.c1.eq.tab) then	!strip away separators
 95              	      cmd = cmd(2:)
 96              	      char_cnt = char_cnt + 1
 97              	   else					!Found non-separator char.
 98              	      if (stripped) then
 99              		more = .false.			!All done.
100              	      else	      			!Extract substring.
101              		stripped = .true.
102              		pos_of_sp = index(cmd,sp)		!find position of next sep.
103              		pos_of_tab = index(cmd,tab)
104              		if (pos_of_sp.eq.0) pos_of_sp = len_cmd + 1
105              		if (pos_of_tab.eq.0) pos_of_tab = len_cmd + 1
106 gaskelld 1.1 		pos_of_sep = min(pos_of_sp,pos_of_tab)
107              		len_word = pos_of_sep - 1
108              		p1 = cmd(1:min(len_word,len_p1))	!save the word
109              		cmd = cmd(min(pos_of_sep,len_cmd):len_cmd) !remove word from cmd
110              		char_cnt = char_cnt + len_word
111              	      endif
112              	   endif
113              	enddo
114              
115              	strip = stripped			!return strip condition
116              	return
117              	end
118              
119              !###############################################################################
120              
121              	logical function rd_int(string,number)
122              C+______________________________________________________________________________
123              !
124              ! Strip the leading substring out of STRING and try to convert it into
125              ! An integer. If STRING is blank, or the conversion failed, the function
126              ! returns .FALSE. Otherwise, .TRUE. is returned, and the integer value
127 gaskelld 1.1 ! is returned in NUMBER.
128              C-______________________________________________________________________________
129              
130              	implicit none
131              	integer*4 l,last_char
132              
133              	integer*4 number
134              	character*(*) string
135              	character*32 str1
136              	logical strip
137              	save
138              
139              C ============================= Executable Code ================================
140              
141              	rd_int = .false.			!assume failure
142              	if (.not.strip(string,str1)) return	!Return if no words
143              	l = last_char(str1)
144              	read (str1(1:l),'(i)',err=999) number	!Try to read word as integer.
145              	rd_int = .true.				!Success.
146              999	return
147              	end
148 gaskelld 1.1 
149              !###############################################################################
150              
151              	logical function rd_logical(string,value)
152              C+______________________________________________________________________________
153              !
154              ! Strip the leading substring out of STRING and try to convert it into
155              ! a logical value. If STRING is blank, or the conversion failed, the function
156              ! returns .FALSE. Otherwise, .TRUE. is returned, and the integer value
157              ! is returned in value.
158              C-______________________________________________________________________________
159              
160              	implicit none
161              	integer*4 l,last_char
162              
163              	logical value
164              	character*(*) string
165              	character*32 str1
166              	logical strip
167              	save
168              
169 gaskelld 1.1 C ============================= Executable Code ================================
170              
171              	rd_logical = .false.			!assume failure
172              	if (.not.strip(string,str1)) return	!Return if no words
173              	l = last_char(str1)
174              	read (str1(1:l),'(L)',err=999) value	!Try to read word as logical.
175              	rd_logical = .true.			!Success.
176              999	return
177              	end
178              
179              !###############################################################################
180              
181              	logical function rd_hex(string,number)
182              C+______________________________________________________________________________
183              !
184              ! Strip the leading substring out of STRING and try to convert it from a
185              ! HEX string into an integer. If STRING is blank, or the conversion failed,
186              ! the function returns .FALSE. Otherwise, .TRUE. is returned, and the
187              ! integer value is returned in NUMBER.
188              C-______________________________________________________________________________
189              
190 gaskelld 1.1 	implicit none
191              	integer*4 l,last_char
192              
193              	integer*4 number
194              	character*(*) string
195              	character*32 str1
196              	logical strip
197              	save
198              
199              C ============================= Executable Code ================================
200              
201              	rd_hex = .false.			!assume failure
202              	if (.not.strip(string,str1)) return
203              	l = last_char(str1)
204              	read (str1(1:l),'(Z)',err=999) number
205              	rd_hex = .true.
206              999	return
207              	end
208              
209              !###############################################################################
210              
211 gaskelld 1.1 	logical function rd_real(string,number)
212              C+______________________________________________________________________________
213              !
214              ! Strip the leading substring out of STRING and try to convert it into
215              ! An R*4 number. If STRING is blank, or the conversion failed, the function
216              ! returns .FALSE. Otherwise, .TRUE. is returned, and the R*4 value
217              ! is returned in NUMBER.
218              C-______________________________________________________________________________
219              
220              	implicit none
221              	integer*4 l,last_char
222              
223              	real*8 number
224              	character*(*) string
225              	character*32 str1
226              	logical	strip
227              	save
228              
229              C ============================= Executable Code ================================
230              
231              	rd_real = .false.			!assume failure
232 gaskelld 1.1 	if (.not.strip(string,str1)) return
233              	l = last_char(str1)
234              	read (str1(1:l),*,err=999) number
235              	rd_real = .true.
236              999	return
237              	end