00001
00002 c
00003 c Copyright (c) 1986,1987,1988,1989,1990,1991,1992,1993,
00004 c by Steve McMillan, Drexel University, Philadelphia, PA.
00005 c
00006 c All rights reserved.
00007 c
00008 c Redistribution and use in source and binary forms are permitted
00009 c provided that the above copyright notice and this paragraph are
00010 c duplicated in all such forms and that any documentation,
00011 c advertising materials, and other materials related to such
00012 c distribution and use acknowledge that the software was developed
00013 c by the author named above.
00014 c
00015 c THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
00016 c IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
00017 c WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
00018 c
00019
00020 c Contents: sdecode -- decode a string into one or more integers
00021 c decode -- decode a character into an integer.
00022 c rdecode -- decode a string into a range of integers.
00023
00024 subroutine sdecode(string,narg,iarg,*)
00025 c
00026 c Decode narg (< = 3) arguments from the given string.
00027 c Delimiters are " " or ",".
00028 c
00029 c The string itself is unaltered on return.
00030 c
00031 character*(*) string
00032 integer iarg(3)
00033 c
00034 if (narg.gt.3) return
00035 c
00036 ibl = 1
00037 jarg = 0
00038 do i = 1,len(string)
00039 if (string(i:i).eq.' '.or.string(i:i).eq.',') then
00040 ibl = 1
00041 else
00042 if (ibl.eq.1) then
00043 jarg = jarg+1
00044 c
00045 if (i.eq.len(string).or.string(i+1:i+1).eq.' '
00046 & .or.string(i+1:i+1).eq.',') then
00047 call decode(string(i:i),iarg(jarg),*50)
00048 go to 75
00049 end if
00050 c
00051 c Attempt to interpret an illegal character or a longer
00052 c string as an integer.
00053 c
00054 50 call readiq(string,i,len(string),1,
00055 & ia,idum,idum,idum,*1001)
00056 iarg(jarg) = ia
00057 c
00058 75 if (jarg.ge.narg) return
00059 ibl = 0
00060 end if
00061 end if
00062 end do
00063 c
00064 do j = jarg+1,narg
00065 iarg(j) = 0
00066 end do
00067 c
00068 return
00069 1001 return 1
00070 c
00071 end
00072
00073
00074 subroutine decode(ch,i,*)
00075 c
00076 c Return 1, 2, or 3 as the code for the input character.
00077 c
00078 character*1 ch
00079 c
00080 if (ch.eq.'x'.or.ch.eq.'X'.or.ch.eq.'1') then
00081 i = 1
00082 else if (ch.eq.'y'.or.ch.eq.'Y'.or.ch.eq.'2') then
00083 i = 2
00084 else if (ch.eq.'z'.or.ch.eq.'Z'.or.ch.eq.'3') then
00085 i = 3
00086 else
00087 return 1
00088 end if
00089 c
00090 end
00091
00092
00093 subroutine rdecode(str,nh,i1,i2,*)
00094 c
00095 c Extract numbers from the input string. String format may be
00096 c i1:i2 or i1#i2 or i1^i2. In the event of an error reading i2,
00097 c return i2 = i1 (this allows a dual function for this routine).
00098 c
00099 c The value of str is not altered. The (unchanged) variable
00100 c nh is used to set an upper limit on the values returned.
00101 c
00102 character*(*) str
00103 c
00104 l = len(str)
00105 c
00106 do if = 1,l
00107 if (str(if:if).gt.' ') go to 2
00108 end do
00109 return 1
00110 c
00111 2 do il = l,if,-1
00112 if (str(il:il).gt.' ') go to 4
00113 end do
00114 c
00115 c String runs from if to il.
00116 c
00117 4 do i = if,il
00118 if (str(i:i).eq.':'.or.str(i:i).eq.'^'
00119 & .or.str(i:i).eq.'#') go to 20
00120 end do
00121 i = il+1
00122 c
00123 c Internal delimiter is at location i.
00124 c
00125 20 if (i.gt.if) then
00126 read(str(if:i-1),*,err = 999,end = 999)i1
00127 else
00128 i1 = 1
00129 end if
00130 c
00131 if (i.lt.il) then
00132 read(str(i+1:il),*,iostat = io)i2
00133 if (io.ne.0) i2 = i1
00134 else if (i.eq.il) then
00135 i2 = nh
00136 else
00137 i2 = i1
00138 end if
00139 c
00140 if (i1.lt.0.or.i2.lt.0)
00141 & write(6,*)'Warning: non-relocatable '
00142 & 'historical reference'
00143
00144 if (i1.lt.0) i1 = nh+1+i1
00145 if (str(i:i).eq.'^'.or.str(i:i).eq.'#') then
00146 i2 = abs(i2)
00147 i2 = i1+i2-1
00148 end if
00149 if (i2.lt.0) i2 = nh+1+i2
00150 i1 = max(0,min(nh,i1))
00151 i2 = min(max(i1,i2),nh)
00152 c
00153 return
00154 c
00155 999 return 1
00156 c
00157 end
