if((y2.lt.ywmin).or.(y2.gt.ywmax)) return
if((y1.lt.ywmin).or.(y1.gt.ywmax)) return
xnn(1)=x1
xnn(2)=x2
ynn(1)=y1
ynn(2)=y2
call line(xnn,ynn,2,iline)
return
end
c
c
subroutine lblcon(x,y,k)
c
c label the contours
c
common/window/xwmin,xwmax,ywmin,ywmax
save /window/
if((x.lt.xwmin).or.(x.gt.xwmax)) return
if((y.lt.ywmin).or.(y.gt.ywmax)) return
ak=float(k)
call number(x,y,.008,ak,-1,0.)
return
end
c
c
subroutine setctr(numnp,xx,yy,zz,nctrs,zc)
c
cdefine contour values inside the window--this routine
cmay be altered by the user to obtain desired contour
cintervals
c
common/window/xwmin,xwmax,ywmin,ywmax
save /window/
dimension xx(1),yy(1),zz(1),zc(1)
zmin=1.e32
zmax=-1.e32
do 30 j=1,numnp
if((xx(j).lt.xwmin).or.(xx(j).gt.xwmax)) goto 30
if((yy(j).lt.ywmin).or.(yy(j).gt.ywmax)) goto 30
if(zz(j).gt.zmax) zmax=zz(j)
if(zz(j).lt.zmin) zmin=zz(j)
30 continue
if(nctrs.lt.2) go to 50
dc = (zmax-zmin)/float(nctrs+1)
do 40 i = 1,nctrs
zc(i) = zmin+dc*float(i)
40 continue
50 return
end
c
c
subroutine zint(i,j,xc,yc,x,y,z,zc)
c
c
c do linear interpolation to find point where
ccontour line crosses side i,j.
c
dimension x(4),y(4),z(4)
if(z(i) .eq. z(j)) go to 10
zsl=(zc-z(i))/(z(j)-z(i))
xc=x(i)+(x(j)-x(i))*zsl
yc=y(i)+(y(j)-y(i))*zsl
return
10 xc = x(i)
yc = y(i)
return
end
c
c
subroutine triien(ien,nx,ny,numel)
c
cprogram to construct the ien array for a rectangular grid
cnx points long and ny points high. assumes three node triangular
celements. this routine also returns numel, the number of
celements for use in the contouring routine. the use of
ctriangular elements resolves any ambiguity in contour positions.
c
cnote: numel=2*(nx-1)*(ny-1) and the node number nn for x(nn) is
cdetermined from an array xx(i,j) is nn = i+(j-1)*nx
c(normal fortran storage order)
c
c
dimension ien(4,*)
numel=0
do 100 j=1,ny-1
do 100 i=1,nx-1
numel=numel+1
ncornr=i+(j-1)*nx
ien(1,numel)=ncornr
ien(2,numel)=ncornr+nx+1
ien(3,numel)=ncornr+nx
ien(4,numel)=ien(3,numel)
numel=numel+1
ien(1,numel)=ncornr
ien(2,numel)=ncornr+1
ien(3,numel)=ncornr+nx+1
ien(4,numel)=ien(3,numel)
100 continue
return
end
c
c
function nchar(string)
c
c determines the minimum nonblank length of a string
c
character*(*) string
character blank
data blank/' '/
nmax=len(string)
nchar=0
do 10 i=1,nmax
itest=nmax-i+1
if(string(itest:itest).ne.blank) then
nchar=itest
return
endif
10continue
return
end
c
c
function nnblnk(string)
c
c determines the position of the first nonblank entry
c of a string (returns 1 if the first character is
c not blank)
c
character*(*) string
character blank
data blank/' '/
nmax=len(string)
nnblnk=nmax
do 10 i=1,nmax
if(string(i:i).ne.blank) then
nnblnk=i
return
endif
10continue
return
end
c
c
block data inital
c
c program to initialize labeled commons in pltlib
c
common/ticdat/ndecx,nticx,nlticx,ndecy,nticy,nlticy
common/lindat/ipen,iline
common/scales/firsx,enx,firsy,eny
common/grd/lgrid,xlngth,ylngth,xmin,xmax,ymin,ymax,title(8)
common/window/xwmin,xwmax,ywmin,ywmax
common/exec/kexec
common/conturdat/icontur,zc(99)
save /ticdat/,/lindat/,/scales/,/grd/,/window/
data ndecx,nticx,nlticx,ndecy,nticy,nlticy/6*0/
data ipen,iline/2*0/
data kexec/0/,icontur/0/
data firsx,enx,firsy,eny/4*0.e0/
data lgrid,xlngth,ylngth,xmin,xmax,ymin,ymax,title
& /0,14*0.e0/
data xwmin,xwmax,ywmin,ywmax/-1.e32,1.e32,-1.e32,1.e32/
end
--
Summary: internal compiler error: in
instantiate_virtual_regs_lossage ERROR 1
Product: gcc
Version: 4.0.1
Status: UNCONFIRMED
Severity: normal
Priority: P3
Component: libfortran
AssignedTo: unassigned at gcc dot gnu dot org
ReportedBy: hcolella at gmail dot com
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=42763
