kjer je xij polozaj ni
sosednjih vozlisc povezanih na tocko i. Proces konvergira v dveh
do petih iteracijah. Problemi nastanejo lahko pri konkavnih površinah.
Izdelati je potrebno program, ki bo prebral mrezo popisano v vhodni
datoteki in izrisal zacetno in koncno stanje.
Celotna teorija enostavnega glajenja mreze je v popisana z enacbo (1).
Glajenje mreze izvajamo s premikanjem notranjih vozlisc mreze v geometricno
sredino sosednjih vozlisc povezanih z notranjim vozlišcem. Nov polozaj
notranje tocke dolocimo torej po enacbi (1).
Na Sliki 1 je prikazana mreza, kakršno jo preberemo iz datoteke,
na Sliki 2 pa je prikazana mreza po izvajanem glajenju.
`
Primer programa:
Sl.3: Primer glajenja mreze
C PROGRAM,
KI IZVAJA GLAJENJE MREZE V 3D
C
C
Include
'phigsdef.f'
Dimension
T(4,10),NovTX(10),NovTY(10),NovTZ(10),Pov(100,100)
Dimension
R(50,2)
Real
a,D,T,NovTX,NovTY,NovTZ,eps,fi,ro
Real
WindowLimits(4) /-1.0,5.0,-2.0,2.0/
Real
ViewportLimits(4) /0.0,1.0,0.0,1.0/
Real
ClipLimits(4) /0.0,1.0,0.0,1.0/
Real
ViewMappingMatrix (3,3)
Real
px(2),py(2)
Integer
n,Povezav,Pov,Tock,wkid,ErrorReturn,i,j,R
Logical
NIDOVOLJ
Character*13 InDat
Character*13 UotDat
1000 write(*,'(A)') ' Podaj ime
vhodne datoteke:'
read*,InDat
write(*,*)
Open(1,File=InDat,Status='old')
C Branje tock
read
(1,*) Tock
do
j=1,Tock
read (1,*) (T(i,j),i=1,4)
end
do
C Branje robov
- povezav
C (najprej
naredimo matriko povezav, vrednosti 0)
do i=1,Tock
do j=1,Tock
Pov(i,j)=0
end do
end
do
Povezav=0
50 read
(1,*,end =100) i,j
if (Pov(i,j).eq.0) then
Pov(j,i)=1
Pov(i,j)=1
Povezav=Povezav+1
R(Povezav,1)=i
R(Povezav,2)=j
endif
goto
50
100 close(1)
write(*,*)
' Izberi eno od naslednjih moznosti:'
write(*,*)
write(*,*)
'0. Izhod iz programa'
write(*,*)
'1. Ponovna izbira datoteke'
write(*,*)
'2. Graficni prikaz'
write(*,'(A)')
' Pritisni ustrezno tipko:'
read
(*,*) odg
write(*,*)
if(odg)
77,999,55
55 if(odg-2) 1000,1111,77
77 write(*,*) '
Napacno izbrana tipka,ponovi izbiro'
write(*,*)
goto
100
C DOLOCITEV
MEJE PREMIKA TOCKE
c
1111 eps=0.002
C ***************** DELO S PHIGSOM ***********************
C ODPREMO PHIGS
(PhigsOpenPhigs)
call
popph(4,0)
C ODPREMO DELOVNO
POSTAJO (PhigsOpenWorkstation)
wkid=1
call
popwk(wkid," ",WK211280)
C IZRAcUN MATRIKE
ZA PRESLIKAVO (EvaluateViewMappingMatrix)
call
pevmm(WindowLimits,ViewportLimits,ErrorReturn,
*
ViewMappingMatrix)
do
20 i=1,3
do 25 j=1,3
write(*,*)ViewMappingMatrix(i,j)
25
continue
20
continue
C NASTAVITEV
UPORABNISKEGA KOORDINATNEGA SISTEMA
c (PhigsSetWorKstationWindow)
C (wkid,xmin,xmax,ymin,ymax)
call
pswkw(wkid,0.0,1.0,0.0,1.0)
C NASTAVITEV
ZASLONSKIH KOORDINAT
c (PhigsSetWorKstationViewport)
call
pswkv(wkid,0.0,0.2,0.0,0.133)
C DOLOCITEV
BARVE CRTE
C (PhigsSetPolyLineColorIndex)
C Indeksi:
C
1 = bela, 2 = rdeca, 3 = rumena,
C
4 = zelena, 5 = svetlo modra, 6 = modra,
C
7 = violicna, 8 = crna (ozadje)
C call psplci(1)
C DOLOCITEV
DEBELINE CRTE
C (PhigsSetLinewidthScaleFactor)
C call pslwsc(1)
C DOLOCITEV
TIPA CRTE
c (PhigsSetLineType)
C call psln(1)
C NASTAVITEV
VELIKOSTI IZRISA TEKSTA (v m)
C (PhigsSetCharacterHeight)
call
pschh(0.009)
C DOLOCITEV BARVE TEKSTA
C (PhigsSetTextColourIndex)
call pstxci(5)
C DOLOCITEV FONTOV ZA IZRIS TEKSTA
C (PhigsSetTextFont)
call pstxfn(1)
C NASTAVITEV
PORAVNAVE TEKSTA
C (PhigsSetTextAlignment)
call
pstxal(pacent,0)
C *************
DOLOCITEV ZASUKA KOORDINATNIH OSI **************
C Zasuk Y od
vertikale
fi=(60.0*3.14159265359)/180.0
C Zasuk X
od horizontale
ro=(10.0*3.14159265359)/180.0
C ****************
RISANJE MREZE PRED GLAJANJEM ****************
call pswkv(wkid,0.0,0.2,0.0,0.133)
do
j=1,Povezav
px(1)=(T(1,R(j,1))*(cos(ro))+T(2,R(j,1))*(sin(fi)))
px(2)=(T(1,R(j,2))*(cos(ro))+T(2,R(j,2))*(sin(fi)))
py(1)=(T(2,R(j,1))*(cos(fi))-T(1,R(j,1))*(sin(ro)))+T(3,R(j,1))
py(2)=(T(2,R(j,2))*(cos(fi))-T(1,R(j,2))*(sin(ro)))+T(3,R(j,2))
if((T(4,R(j,1)).eq.1).and.(T(4,R(j,2)).eq.1)) then
call psplci(1)
call pslwsc(2)
call psln(1)
else
call psplci(3)
call psln(pldot)
end if
call ppl(2,px,py)
end
do
C IZPIS TEXTA
C (PhigsText)
call
ptx(1.0,3.0,'Mreza pred glajenjem')
C *** IZRIS ZACETNEGA STANJA ***
call pswkv(wkid,0.0,0.2,0.0,0.133)
do
j=1,Povezav
px(1)=4+(T(1,R(j,1))*(cos(ro))+T(2,R(j,1))*(sin(fi)))
px(2)=4+(T(1,R(j,2))*(cos(ro))+T(2,R(j,2))*(sin(fi)))
py(1)=(T(2,R(j,1))*(cos(fi))-T(1,R(j,1))*(sin(ro)))+T(3,R(j,1))
py(2)=(T(2,R(j,2))*(cos(fi))-T(1,R(j,2))*(sin(ro)))+T(3,R(j,2))
if((T(4,R(j,1)).eq.1).and.(T(4,R(j,2)).eq.1)) then
call psplci(1)
call pslwsc(2)
call psln(1)
else
call psplci(3)
call psln(pldot)
end if
call ppl(2,px,py)
end
do
C Cakanje med izrisom
do i=1,200
do j=1,100000
end do
end do
C Brisanje zadnje slike
call pswkv(wkid,0.0,0.2,0.0,0.133)
do j=1,Povezav
px(1)=4+(T(1,R(j,1))*(cos(ro))+T(2,R(j,1))*(sin(fi)))
px(2)=4+(T(1,R(j,2))*(cos(ro))+T(2,R(j,2))*(sin(fi)))
py(1)=(T(2,R(j,1))*(cos(fi))-T(1,R(j,1))*(sin(ro)))+T(3,R(j,1))
py(2)=(T(2,R(j,2))*(cos(fi))-T(1,R(j,2))*(sin(ro)))+T(3,R(j,2))
call psplci(8)
call psln(1)
call ppl(2,px,py)
end do
C ****************
ZACETEK ITERACIJSKEGA RACUNANJA **************
NIDOVOLJ=.TRUE.
Do
while(NIDOVOLJ)
NIDOVOLJ=.FALSE.
do n=1,Tock
if (T(4,n).eq.0) then
index=0
NovTX(n)=0
NovTY(n)=0
NovTZ(n)=0
do j=1,Tock
if (Pov(j,n).eq.1) then
NovTX(n)=NovTX(n)+T(1,j)
NovTY(n)=NovTY(n)+T(2,j)
NovTZ(n)=NovTZ(n)+T(3,j)
index=index+1
end if
end do
C
RACUNANJE RAZDALJE MED NOVO IN STARO VREDNOSTJO
NovTX(n)=NovTX(n)/index
NovTY(n)=NovTY(n)/index
NovTZ(n)=NovTZ(n)/index
a=(T(1,n)-NovTX(n))**2+(T(2,n)-NovTY(n))**2
D=SQRT(a+(T(3,n)-NovTZ(n))**2)
T(1,n)=NovTX(n)
T(2,n)=NovTY(n)
T(3,n)=NovTZ(n)
if (D.gt.eps) then
NIDOVOLJ=.TRUE.
end if
end if
end do
C Risanje vmesnih stopenj
call pswkv(wkid,0.0,0.2,0.0,0.133)
do j=1,Povezav
px(1)=4+(T(1,R(j,1))*(cos(ro))+T(2,R(j,1))*(sin(fi)))
px(2)=4+(T(1,R(j,2))*(cos(ro))+T(2,R(j,2))*(sin(fi)))
py(1)=(T(2,R(j,1))*(cos(fi))-T(1,R(j,1))*(sin(ro)))+T(3,R(j,1))
py(2)=(T(2,R(j,2))*(cos(fi))-T(1,R(j,2))*(sin(ro)))+T(3,R(j,2))
if((T(4,R(j,1)).eq.1).and.(T(4,R(j,2)).eq.1)) then
call psplci(1)
call pslwsc(2)
call psln(1)
else
call psplci(3)
call psln(pldot)
end if
call ppl(2,px,py)
end do
C Cakanje med izrisom
do i=1,200
do j=1,100000
end do
end do
C Brisanje zadnje slike
call pswkv(wkid,0.0,0.2,0.0,0.133)
do j=1,Povezav
px(1)=4+(T(1,R(j,1))*(cos(ro))+T(2,R(j,1))*(sin(fi)))
px(2)=4+(T(1,R(j,2))*(cos(ro))+T(2,R(j,2))*(sin(fi)))
py(1)=(T(2,R(j,1))*(cos(fi))-T(1,R(j,1))*(sin(ro)))+T(3,R(j,1))
py(2)=(T(2,R(j,2))*(cos(fi))-T(1,R(j,2))*(sin(ro)))+T(3,R(j,2))
call psplci(8)
call psln(1)
call ppl(2,px,py)
end do
end do
C ************* DOLOCITEV ZASUKA KOORDINATNIH OSI **************
C Zasuk Y od
vertikale
fi=(60.0*3.14159265359)/180.0
C Zasuk X
od horizontale
ro=(10.0*3.14159265359)/180.0
C ****************
RISANJE MREZE PO GLAJENJU ****************
call
pswkv(wkid,0.0,0.2,0.0,0.133)
do
j=1,Povezav
px(1)=4+(T(1,R(j,1))*(cos(ro))+T(2,R(j,1))*(sin(fi)))
px(2)=4+(T(1,R(j,2))*(cos(ro))+T(2,R(j,2))*(sin(fi)))
py(1)=(T(2,R(j,1))*(cos(fi))-T(1,R(j,1))*(sin(ro)))+T(3,R(j,1))
py(2)=(T(2,R(j,2))*(cos(fi))-T(1,R(j,2))*(sin(ro)))+T(3,R(j,2))
if((T(4,R(j,1)).eq.1).and.(T(4,R(j,2)).eq.1)) then
call psplci(1)
call pslwsc(2)
call psln(1)
else
call psplci(3)
call psln(pldot)
end if
call ppl(2,px,py)
end
do
C IZPIS TEXTA
C (PhigsText)
call
ptx(5.0,3.0,'Mreza po glajenju')
pause
C ZAPREMO
DELOVNO POSTAJO
C (PhigsCloseWorkstation)
call
pclwk(wkid)
C ZAPREMO
PHIGS (zakljucimo z graficnim nacinom dela)
c (PhigsClosePhigs)
call
pclph()
goto 100
999 end