207 lines
7.2 KiB
Fortran
207 lines
7.2 KiB
Fortran
subroutine ehg182(i)
|
|
integer i
|
|
if(i.eq.100) print *,'wrong version number in lowesd. Probably ty
|
|
+po in caller.'
|
|
if(i.eq.101) print *,'d>dMAX in ehg131. Need to recompile with in
|
|
+creased dimensions.'
|
|
if(i.eq.102) print *,'liv too small. (Discovered by lowesd)'
|
|
if(i.eq.103) print *,'lv too small. (Discovered by lowesd)'
|
|
if(i.eq.104) print *,'alpha too small. fewer data values than deg
|
|
+rees of freedom.'
|
|
if(i.eq.105) print *,'k>d2MAX in ehg136. Need to recompile with i
|
|
+ncreased dimensions.'
|
|
if(i.eq.106) print *,'lwork too small'
|
|
if(i.eq.107) print *,'invalid value for kernel'
|
|
if(i.eq.108) print *,'invalid value for ideg'
|
|
if(i.eq.109) print *,'lowstt only applies when kernel=1.'
|
|
if(i.eq.110) print *,'not enough extra workspace for robustness ca
|
|
+lculation'
|
|
if(i.eq.120) print *,'zero-width neighborhood. make alpha bigger'
|
|
if(i.eq.121) print *,'all data on boundary of neighborhood. make a
|
|
+lpha bigger'
|
|
if(i.eq.122) print *,'extrapolation not allowed with blending'
|
|
if(i.eq.123) print *,'ihat=1 (diag L) in l2fit only makes sense if
|
|
+ z=x (eval=data).'
|
|
if(i.eq.171) print *,'lowesd must be called first.'
|
|
if(i.eq.172) print *,'lowesf must not come between lowesb and lowe
|
|
+se, lowesr, or lowesl.'
|
|
if(i.eq.173) print *,'lowesb must come before lowese, lowesr, or l
|
|
+owesl.'
|
|
if(i.eq.174) print *,'lowesb need not be called twice.'
|
|
if(i.eq.180) print *,'nv>nvmax in cpvert.'
|
|
if(i.eq.181) print *,'nt>20 in eval.'
|
|
if(i.eq.182) print *,'svddc failed in l2fit.'
|
|
if(i.eq.183) print *,'didnt find edge in vleaf.'
|
|
if(i.eq.184) print *,'zero-width cell found in vleaf.'
|
|
if(i.eq.185) print *,'trouble descending to leaf in vleaf.'
|
|
if(i.eq.186) print *,'insufficient workspace for lowesf.'
|
|
if(i.eq.187) print *,'insufficient stack space'
|
|
if(i.eq.188) print *,'lv too small for computing explicit L'
|
|
if(i.eq.191) print *,'computed trace L was negative; something is
|
|
+wrong!'
|
|
if(i.eq.192) print *,'computed delta was negative; something is wr
|
|
+ong!'
|
|
if(i.eq.193) print *,'workspace in loread appears to be corrupted'
|
|
if(i.eq.194) print *,'trouble in l2fit/l2tr'
|
|
if(i.eq.195) print *,'only constant, linear, or quadratic local mo
|
|
+dels allowed'
|
|
if(i.eq.196) print *,'degree must be at least 1 for vertex influen
|
|
+ce matrix'
|
|
if(i.eq.999) print *,'not yet implemented'
|
|
print *,'Assert failed, error code ',i
|
|
stop
|
|
end
|
|
subroutine ehg183(s,i,n,inc)
|
|
character*(*) s
|
|
integer n, inc, i(inc,n), j
|
|
print *,s,(i(1,j),j=1,n)
|
|
end
|
|
subroutine ehg184(s,x,n,inc)
|
|
character*(*) s
|
|
integer n, inc, j
|
|
double precision x(inc,n)
|
|
print *,s,(x(1,j),j=1,n)
|
|
end
|
|
subroutine losave(iunit,iv,liv,lv,v)
|
|
integer execnt,iunit,liv,lv
|
|
integer iv(liv)
|
|
DOUBLE PRECISION v(lv)
|
|
external ehg167
|
|
save execnt
|
|
data execnt /0/
|
|
execnt=execnt+1
|
|
call ehg167(iunit,iv(2),iv(4),iv(5),iv(6),iv(14),v(iv(11)),iv(iv(7
|
|
+)),v(iv(12)),v(iv(13)))
|
|
return
|
|
end
|
|
subroutine ehg167(iunit,d,vc,nc,nv,nvmax,v,a,xi,vval)
|
|
integer iunit,d,vc,nc,nv,a(nc),magic,i,j
|
|
DOUBLE PRECISION v(nvmax,d),xi(nc),vval(0:d,nv)
|
|
write(iunit,*)d,nc,nv
|
|
do 10 i=1,d
|
|
10 write(iunit,*)v(1,i),v(vc,i)
|
|
j = 0
|
|
do 20 i=1,nc
|
|
if(a(i).ne.0)then
|
|
write(iunit,*)a(i),xi(i)
|
|
else
|
|
write(iunit,*)a(i),j
|
|
end if
|
|
20 continue
|
|
do 30 i=1,nv
|
|
30 write(iunit,*)(vval(j,i),j=0,d)
|
|
end
|
|
subroutine lohead(iunit,d,vc,nc,nv)
|
|
integer iunit,d,vc,nc,nv
|
|
read(iunit,*)d,nc,nv
|
|
vc = 2**d
|
|
end
|
|
subroutine loread(iunit,d,vc,nc,nv,iv,liv,lv,v)
|
|
integer bound,d,execnt,iunit,liv,lv,nc,nv,vc
|
|
integer iv(liv)
|
|
DOUBLE PRECISION v(lv)
|
|
external ehg168,ehg169,ehg182
|
|
save execnt
|
|
data execnt /0/
|
|
execnt=execnt+1
|
|
iv(28)=173
|
|
iv(2)=d
|
|
iv(4)=vc
|
|
iv(14)=nv
|
|
iv(17)=nc
|
|
iv(7)=50
|
|
iv(8)=iv(7)+nc
|
|
iv(9)=iv(8)+vc*nc
|
|
iv(10)=iv(9)+nc
|
|
bound=iv(10)+nc
|
|
if(.not.(bound-1.le.liv))then
|
|
call ehg182(102)
|
|
end if
|
|
iv(11)=50
|
|
iv(13)=iv(11)+nv*d
|
|
iv(12)=iv(13)+(d+1)*nv
|
|
bound=iv(12)+nc
|
|
if(.not.(bound-1.le.lv))then
|
|
call ehg182(103)
|
|
end if
|
|
call ehg168(iunit,d,vc,nc,nv,nv,v(iv(11)),iv(iv(7)),v(iv(12)),v(iv
|
|
+(13)))
|
|
call ehg169(d,vc,nc,nc,nv,nv,v(iv(11)),iv(iv(7)),v(iv(12)),iv(iv(8
|
|
+)),iv(iv(9)),iv(iv(10)))
|
|
return
|
|
end
|
|
subroutine ehg168(iunit,d,vc,nc,nv,nvmax,v,a,xi,vval)
|
|
integer iunit,d,vc,nc,nv,a(nc),magic,i,j
|
|
DOUBLE PRECISION v(nvmax,d),xi(nc),vval(0:d,nv)
|
|
do 10 i=1,d
|
|
10 read(iunit,*)v(1,i),v(vc,i)
|
|
do 20 i=1,nc
|
|
20 read(iunit,*)a(i),xi(i)
|
|
do 30 i=1,nv
|
|
30 read(iunit,*)(vval(j,i),j=0,d)
|
|
end
|
|
subroutine ehg170(k,d,vc,nv,nvmax,nc,ncmax,a,c,hi,lo,v,vval,xi)
|
|
integer d,execnt,i,j,nc,ncmax,nv,nvmax,vc
|
|
integer a(ncmax),c(vc,ncmax),hi(ncmax),lo(ncmax)
|
|
double precision v(nvmax,d),vval(0:d,nvmax),xi(ncmax)
|
|
save execnt
|
|
data execnt /0/
|
|
execnt=execnt+1
|
|
write(k,*)' double precision function loeval(z)'
|
|
write(k,50)d
|
|
write(k,*)' integer d,vc,nv,nc'
|
|
write(k,51)nc,vc,nc
|
|
write(k,52)nc,nc
|
|
write(k,53)nv,d
|
|
write(k,54)d,nv
|
|
write(k,55)nc
|
|
write(k,56)
|
|
write(k,57)d,vc,nv,nc
|
|
50 format(' double precision z(',i2,')')
|
|
51 format(' integer a(',i5,'), c(',i3,',',i5,')')
|
|
52 format(' integer hi(',i5,'), lo(',i5,')')
|
|
53 format(' double precision v(',i5,',',i2,')')
|
|
54 format(' double precision vval(0:',i2,',',i5,')')
|
|
55 format(' double precision xi(',i5,')')
|
|
56 format(' double precision ehg128')
|
|
57 format(' data d,vc,nv,nc /',i2,',',i3,',',i5,',',i5,'/')
|
|
do 3 i=1,nc
|
|
write(k,58)i,a(i)
|
|
58 format(' data a(',i5,') /',i5,'/')
|
|
if(a(i).ne.0)then
|
|
write(k,59)i,i,i,hi(i),lo(i),xi(i)
|
|
59 format(' data hi(',i5,'),lo(',i5,'),xi(',i5,') /',
|
|
$ i5,',',i5,',',1pe15.6,'/')
|
|
end if
|
|
do 4 j=1,vc
|
|
write(k,60)j,i,c(j,i)
|
|
60 format(' data c(',i3,',',i5,') /',i5,'/')
|
|
4 continue
|
|
3 continue
|
|
do 5 i=1,nv
|
|
write(k,61)i,vval(0,i)
|
|
61 format(' data vval(0,',i5,') /',1pe15.6,'/')
|
|
do 6 j=1,d
|
|
write(k,62)i,j,v(i,j)
|
|
62 format(' data v(',i5,',',i2,') /',1pe15.6,'/')
|
|
write(k,63)j,i,vval(j,i)
|
|
63 format(' data vval(',i2,',',i5,') /',1pe15.6,'/')
|
|
6 continue
|
|
5 continue
|
|
write(k,*)' loeval=ehg128(z,d,nc,vc,a,xi,lo,hi,c,v,nv,vval)'
|
|
write(k,*)' end'
|
|
return
|
|
end
|
|
subroutine lofort(iunit,iv,liv,lv,wv)
|
|
integer execnt,iunit
|
|
integer iv(*)
|
|
DOUBLE PRECISION wv(*)
|
|
external ehg170
|
|
save execnt
|
|
data execnt /0/
|
|
execnt=execnt+1
|
|
call ehg170(iunit,iv(2),iv(4),iv(6),iv(14),iv(5),iv(17),iv(iv(7)),
|
|
+iv(iv(8)),iv(iv(9)),iv(iv(10)),wv(iv(11)),wv(iv(13)),wv(iv(12)))
|
|
return
|
|
end
|