Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
SUBROUTINE get_values(string,n,values,ok)
*
* $Log: get_values.f,v $
* Revision 1.1 1994/02/22 20:00:24 cdaq
* Initial revision
*
*
IMPLICIT NONE
CHARACTER*(*) string
INTEGER*4 n,values(*),v(2),divider
INTEGER*4 i,j,k,m,value4,cycle,step
INTEGER*2 last_binary,last_oct,last_hex,dummy2
LOGICAL*2 ok,hex,oct,bin
CHARACTER*132 orig,line,this
INTEGER*4 important_length !FUNCTION
INTEGER*4 INDEX !FUNCTION
CHARACTER*1 quote
PARAMETER (quote='''')
c................................................................
n=0
orig= string
CALL no_tabs(orig) !remove tabs
DO WHILE (INDEX(orig,quote).ne.0) !remove quote marks
i=INDEX(orig,quote)
orig(i:i)=' '
ENDDO
DO WHILE (INDEX(orig,'::').ne.0) !replace sequence marks
i=INDEX(orig,'::')
orig(i:i+1)='^ '
ENDDO
DO WHILE (INDEX(orig,':').ne.0) !replace seperator marks
i=INDEX(orig,':')
orig(i:i)=','
ENDDO
CALL NO_blanks(orig) !remove blanks
CALL UP_case(ORIG) !shift to upper case
IF(orig.EQ.' ') THEN
ok=.false. !nothing to read
RETURN
ENDIF
c
line= orig
j= INDEX(line,',')
IF(j.gt.0) line(j:)=' ' !get first line
c
DO WHILE (orig.NE.' ')
c
divider= INDEX(line,'*') !duplicate
If(divider.eq.0) divider= INDEX(line,'^') !sequence
c
If(divider.eq.0) Then
cycle=1
this= line
ElseIf(divider.eq.1) Then
GOTO 2222 !illegal
Else
cycle=2
this= line(1:divider-1)
EndIf
c
Do j=1,cycle
c
last_binary= INDEX(this,'B')
bin= last_binary.ne.0
last_hex= INDEX(this,'H')
If(last_hex.EQ.0) last_hex= INDEX(this,'X')
hex= last_hex.ne.0
last_oct= INDEX(this,'O')
oct= last_oct.ne.0
c
if(hex) then
this(last_hex:)=' '
CALL squeeze(this,i)
IF(this.eq.' ') goto 2222
c READ(this(1:i),'(z)',err=2222) v(j)
READ(this(1:i),'(z10)',err=2222) v(j)
elseif(oct) then
this(last_oct:)=' '
CALL squeeze(this,i)
IF(this.eq.' ') goto 2222
c READ(this(1:i),'(o)',err=2222) v(j)
READ(this(1:i),'(o10)',err=2222) v(j)
elseif(bin) then
this(last_binary:)=' '
CALL squeeze(this,i)
IF(this.eq.' ') goto 2222
value4= 0
DO k=1,i
value4= 2*value4
If(this(k:k).EQ.'1') Then
value4= value4+1
ElseIf(this(k:k).NE.'0') Then
GOTO 2222
EndIf
ENDDO
v(j)= value4 !only take lowest bits
else
CALL squeeze(this,i)
IF(this.eq.' ') goto 2222
c READ(this(1:i),'(i)',err=2222) v(j)
READ(this(1:i),'(i10)',err=2222) v(j)
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
endif
c
this= line(divider+1:)
EndDo
c
ok=.true.
If(cycle.eq.2) Then
if(line(divider:divider).eq.'^') then !sequence "^"
DO k=v(1),v(2),MAX(MIN(v(2)-v(1),1),-1)
n= n+1
values(n)= k
ENDDO
else !duplicate "*"
DO k=1,v(1)
n=n+1
values(n)= v(2)
ENDDO
endif
Else !just single value
n=n+1
values(n)= v(1)
EndIf
c
m= INDEX(orig,',') !find next line
If(m.EQ.0) Then !done
orig=' '
Else !another line
orig(1:m)=' '
CALL no_leading_blanks(orig)
line= orig
m= INDEX(line,',')
if(m.ne.0) line(m:)=' '
EndIf
ENDDO
RETURN
c
2222 ok=.false.
RETURN
END