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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
subroutine intmgetl
c Copyright INRIA/ENPC
INCLUDE '../stack.h'
c
integer mode(2)
integer iadr,sadr
logical checkrhs,checklhs,getscalar
logical opened
c
iadr(l)=l+l-1
sadr(l)=(l/2)+1
c
rhs = max(0,rhs)
if(.not.checkrhs(fname,1,2)) return
if(.not.checklhs(fname,1,1)) return
c opening file
call v2cunit(top-rhs+1,'rb',lunit,opened,ierr)
if(ierr.gt.0) return
c
if(rhs.eq.2) then
if (.not.getscalar('mgetl',top,top,lr)) return
m=stk(lr)
top=top-1
else
m=-1
endif
il=iadr(lstk(top))
ili=il+4
if(m.gt.0) then
c . specified number of lines
err=sadr(ili+2)-lstk(bot)
if(err.gt.0) then
call error(17)
return
endif
li=ili+m+1
istk(ili)=1
do 10 i=1,m
call readnextline(lunit,buf,bsiz,mn,nr,info)
if(info.eq.-1) then
err=i
call error(62)
if(.not.opened) call clunit(-lunit,buf,mode)
return
endif
mn=max(0,mn-1)
err=sadr(li+mn)-lstk(bot)
if(err.gt.0) then
call error(17)
return
endif
call cvstr(mn,istk(li),buf(1:mn),0)
li=li+mn
ili=ili+1
istk(ili)=istk(ili-1)+mn
10 continue
istk(il)=10
istk(il+1)=m
istk(il+2)=1
lstk(top+1)=sadr(li)
elseif(m.eq.0) then
istk(il)=1
istk(il+1)=0
istk(il+2)=0
istk(il+3)=0
lstk(top+1)=sadr(il+4)
else
c . unspecified number of lines
li=ili
i=-1
12 i=i+1
call readnextline(lunit,buf,bsiz,mn,nr,info)
if(info.eq.-1) goto 20
mn=max(0,mn-1)
if(mn.gt.0) then
err=sadr(li+mn+1)-lstk(bot)
if(err.gt.0) then
call error(17)
goto 996
endif
call cvstr(mn,istk(li+1),buf(1:mn),0)
endif
istk(li)=mn
li=li+mn+1
if(info.eq.-1) then
if(mn.gt.0) i=i+1
goto 20
endif
goto 12
20 m=i
if(m.le.0) then
istk(il)=1
istk(il+1)=0
istk(il+2)=0
istk(il+3)=0
lstk(top+1)=sadr(il+4)
else
call icopy(li-ili+1,istk(ili),-1,istk(li+2),-1)
lis=li+2
istk(il)=10
istk(il+1)=m
istk(il+2)=1
istk(ili)=1
li=ili+m+1
do 30 j=1,m
mn=istk(lis)
istk(ili+1)=istk(ili)+mn
call icopy(mn,istk(lis+1),1,istk(li),1)
lis=lis+mn+1
li=li+mn
ili=ili+1
30 continue
lstk(top+1)=sadr(li+1)
endif
endif
996 if(.not.opened) call clunit(-lunit,buf,mode)
return
end
|
