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
|
subroutine intdgebal(fname)
c***************************************************************************
c usage:
c [SCALE, ILOW, IHI]=dgebal(JOB, A)
c************************************************************************
include 'stack.h'
logical getrhsvar,createvar
logical checklhs,checkrhs
character fname*(*)
character job*(1)
c
nbvars=0
minrhs=2
maxrhs=2
minlhs=1
maxlhs=3
c
if(.not.checkrhs(fname,minrhs,maxrhs)) return
if(.not.checklhs(fname,minlhs,maxlhs)) return
c job
if(.not.getrhsvar(1,'c', m1, n1, ljob)) return
job=cstk(ljob:ljob+1)
c A
if(.not.getrhsvar(2,'d', mA, nA, lA)) return
c
if(.not.createvar(3,'d', mA, 1, lscale)) return
if(.not.createvar(4,'i', 1, 1, ilo)) return
if(.not.createvar(5,'i', 1, 1, ihi)) return
call dgebal(job, mA , stk(lA), mA, istk(ilo), istk(ihi),
$ stk(lscale), info)
c call DGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO )
if(info.ne.0) then
call errorinfo("dgebal",info)
return
endif
c return SCALE (3), ILOW (4), IHI (5)
lhsvar(1)=3
lhsvar(2)=4
lhsvar(3)=5
c
return
end
|
