program vijakDIN2509 include 'phigsdef.f' real*4 OG,M,zmn,vek,TO,r,alfar,alfa,alfaz,alf,al,alfk,b,d,e,p,h real KS real kx(2),ky(2),maxto real ViewMappingMatrix(3,3) real WindowLimits(4) real ViewportLimits(4) /0.1,0.9,0.1,0.9/ real ClipLimits(4) /0.0,1.0,0.0,1.0/ real ksx(2),ksy(2) real kxtr,kytr,kxtt,kytt real ksxt,ksyt,kszt integer n,k,ST,i,z integer l,j,ErrorReturn character ime*80 character oznr*6,oznt*8 parameter(pi=3.1415926) dimension OG(150,2),ST(150,2),KS(4,3) dimension vek(3),M(3,3),zmn(3) write(*,*)'Dobrodosli v programu VIJAK DIN 2509!!! ' write(*,*)'Avtor: Marjan Hribljan ' write(*,*)' ' 20 write(*,*)'UPORABNIK NAJ IZBERE ENEGA IZMED VIJAKOV: ' write(*,*)' ' write(*,*)'1 (M12) ' write(*,*)'2 (M16) ' write(*,*)'3 (M20) ' write(*,*)'4 (M24) ' write(*,*)'5 (M27) ' write(*,*)'6 (M30) ' write(*,*)'7 (M33) ' write(*,*)'8 (M36) ' write(*,*)'9 (M39) ' write(*,*)'10 (M42) ' write(*,*)'11 (M45) ' write(*,*)'12 (M48) ' read(*,*)izbor if (izbor.eq.1)then goto 1 elseif (izbor.eq.2)then goto 2 elseif (izbor.eq.3)then goto 3 elseif (izbor.eq.4)then goto 4 elseif (izbor.eq.5)then goto 5 elseif (izbor.eq.6)then goto 6 elseif (izbor.eq.7)then goto 7 elseif (izbor.eq.8)then goto 8 elseif (izbor.eq.9)then goto 9 elseif (izbor.eq.10)then goto 11 elseif (izbor.eq.11)then goto 12 elseif (izbor.eq.12)then goto 13 else stop 'Podatek je bil nepravilno vstavljen! ' endif ! BRANJE PODATKOV IZ DATOTEKE 1 open (1,file='M12.dat',err=1000) goto 14 2 open (1,file='M16.dat',err=1000) goto 14 3 open (1,file='M20.dat',err=1000) goto 14 4 open (1,file='M24.dat',err=1000) goto 14 5 open (1,file='M27.dat',err=1000) goto 14 6 open (1,file='M30.dat',err=1000) goto 14 7 open (1,file='M33.dat',err=1000) goto 14 8 open (1,file='M36.dat',err=1000) goto 14 9 open (1,file='M39.dat',err=1000) goto 14 11 open (1,file='M42.dat',err=1000) goto 14 12 open (1,file='M45.dat',err=1000) goto 14 13 open (1,file='M48.dat',err=1000) 14 read (1,1100)ime read (1,*)n read (1,*)h read (1,*)l read (1,*)b read (1,*)d read (1,*)e read (1,*)p close (1) ! IZRAČUN KOORDINAT ZAČETNIH OGLIŠČ OG(1,1)=0 ! X koordinata prve točke OG(1,2)=-d/2+1 ! y koordinata prve točke OG(2,1)=1 OG(2,2)=-d/2 OG(3,1)=b-h OG(3,2)=-d/2 OG(4,1)=b-h OG(4,2)=d/2 OG(5,1)=1 OG(5,2)=d/2 OG(6,1)=0 OG(6,2)=d/2-1 OG(7,1)=b-h OG(7,2)=d/2-1 OG(8,1)=b-h OG(8,2)=-d/2+1 OG(9,1)=b OG(9,2)=-d/2 OG(10,1)=b+l OG(10,2)=-d/2 OG(11,1)=b+l OG(11,2)=d/2 OG(12,1)=b OG(12,2)=d/2 OG(13,1)=b+l+h OG(13,2)=-d/2 OG(14,1)=b+b+l-1 OG(14,2)=-d/2 OG(15,1)=b+b+l OG(15,2)=-d/2+1 OG(16,1)=b+b+l OG(16,2)=d/2-1 OG(17,1)=b+b+l-1 OG(17,2)=d/2 OG(18,1)=b+l+h OG(18,2)=d/2 OG(19,1)=b+l+h OG(19,2)=d/2-1 OG(20,1)=b+l+h OG(20,2)=-d/2+1 OG(21,1)=b+b+l+e OG(21,2)=-p/2 OG(22,1)=b+b+l+e OG(22,2)=p/2 OG(23,1)=b+b+l OG(23,2)=p/4 OG(24,1)=b+b+l+e OG(24,2)=p/4 OG(25,1)=b+b+l OG(25,2)=-p/4 OG(26,1)=b+b+l+e OG(26,2)=-p/4 OG(27,1)=b+b+l OG(27,2)=p/2 OG(28,1)=b+b+l OG(28,2)=-p/2 !pause !! IZRAČUN KOORDINAT OGLIŠČ NOTRANJEGA, ZUNANJEGA PREMERA in NAVOJA alf=360.0/24.0 ! kot med ogliščema v stopinjah al=(pi/180.0)*alf ! kot med ogliščema v radianih !write(*,*)'T A B E L A Z A C E T N I H O G L I S C ' write(*,*)' ' ! izračun koordinat oglišč notranjega premera: alfk=-al ! začetni kot do i=29,52 ! do zanka šteje spodnja oglišča od 1 do n OG(i,1)=p/2*cos(alfk)-d ! grupiranje koordinat oglišč premera v X polje OG(i,2)=p/2*sin(alfk) ! grupiranje koordinat oglišč premera v Y polje alfk=alfk+al enddo ! koordinate oglišč zunanjega premera: alfk=al do i=53,76 OG(i,1)=d/2*cos(alfk)-d OG(i,2)=d/2*sin(alfk) alfk=alfk+al enddo ! koordinate za srednjico OG(77,1)=-1 OG(77,2)=0 OG(78,1)=b+b+l+e+1 OG(78,2)=0 ! koordinate oglišč navoja alfk=-8*al do i=79,96 OG(i,1)=(d/2-1)*cos(alfk)-d OG(i,2)=(d/2-1)*sin(alfk) alfk=alfk+al enddo !pause ! izračun koordinat 4 lokov ! levi zgornji alfk=-15*al/2 do i=97,100 OG(i,1)=h*5/6*cos(alfk)+b-h/2 OG(i,2)=h*5/6*sin(alfk)+d/2+h*2/3 alfk=alfk+al enddo ! desni zgornji alfk=-15*al/2 do i=101,104 OG(i,1)=h*5/6*cos(alfk)+b+l+h/2 OG(i,2)=h*5/6*sin(alfk)+d/2+h*2/3 alfk=alfk+al enddo ! levi spodnji alfk=9*al/2 do i=105,108 OG(i,1)=h*5/6*cos(alfk)+b-h/2 OG(i,2)=h*5/6*sin(alfk)-d/2-h*2/3 alfk=alfk+al enddo ! desni spodnji alfk=9*al/2 do i=109,112 OG(i,1)=h*5/6*cos(alfk)+b+l+h/2 OG(i,2)=h*5/6*sin(alfk)-d/2-h*2/3 alfk=alfk+al enddo ! koordinate za srednjice kroga OG(113,1)=-d-d/2-1 OG(113,2)=0 OG(114,1)=-d+d/2+1 OG(114,2)=0 OG(115,1)=-d OG(115,2)=-d/2-1 OG(116,1)=-d OG(116,2)=d/2+1 ! koordinate za kotirnice OG(117,1)=0 OG(117,2)=-d OG(118,1)=1 OG(118,2)=-d+1 OG(119,1)=1 OG(119,2)=-d-1 OG(120,1)=b+b+l OG(120,2)=-d OG(121,1)=b+b+l-1 OG(121,2)=-d+1 OG(122,1)=b+b+l-1 OG(122,2)=-d-1 OG(123,1)=b+b+l+e+d/2 OG(123,2)=d/2 OG(124,1)=b+b+l+e+d/2-1 OG(124,2)=d/2-1 OG(125,1)=b+b+l+e+d/2+1 OG(125,2)=d/2-1 OG(126,1)=b+b+l+e+d/2 OG(126,2)=-d/2 OG(127,1)=b+b+l+e+d/2+1 OG(127,2)=-d/2+1 OG(128,1)=b+b+l+e+d/2-1 OG(128,2)=-d/2+1 OG(129,1)=b+l/2 OG(129,2)=-d OG(130,1)=b+b+l+e+d/2 OG(130,2)=2.5 !! POVEZAVA OGLIŠČ VIJAKA V NARISU S STRANICAMI write(*,*)' ' write(*,*)' ' write(*,*)' ' write(*,*)' ' ! stranice vijaka v narisu: do i=1,7 ! do zanka šteje prvih 7 oglišč ST(i,1)=i ! grupiranje prvih oglišč stranic v polja ST(i,2)=i+1 ! grupiranje drugih oglišč stranic v polja enddo ST(7,1)=1 ! grupiranje prvega oglišča sedme stranice v polje ST(7,2)=8 ! grupiranje drugega oglišča sedme stranice v polje ST(8,1)=1 ST(8,2)=6 do i=9,12 ST(i,1)=i ST(i,2)=i+1 enddo ST(12,1)=12 ST(12,2)=9 do i=13,18 ST(i,1)=i ST(i,2)=i+1 enddo ST(18,1)=18 ST(18,2)=13 ST(19,1)=2 ! grupiranje prvega oglišča 19 stranice v polje ST(19,2)=5 ! grupiranje drugega oglišča 19 stranice v polje ST(20,1)=14 ST(20,2)=17 ST(21,1)=16 ST(21,2)=19 ST(22,1)=15 ST(22,2)=20 ST(23,1)=21 ST(23,2)=22 ST(24,1)=23 ST(24,2)=24 ST(25,1)=25 ST(25,2)=26 ST(26,1)=28 ST(26,2)=21 ST(27,1)=27 ST(27,2)=22 ST(28,1)=22 ST(28,2)=21 !! POVEZAVA OGLIŠČ S STRANICAMI KROGOV write(*,*)' ' write(*,*)' ' write(*,*)' ' write(*,*)' ' ! stranice notranjega premera brez zadnjih: do i=29,51 ! do zanka šteje število osnovnih oglišč brez zadnjega ST(i,1)=i ! grupiranje prvih oglišč stranic v polja ST(i,2)=i+1 ! grupiranje drugih oglišč stranic v polja enddo ST(52,1)=52 ! grupiranje prvega oglišča notranjega premera zadnje stranice v polje ST(52,2)=29 ! grupiranje drugega oglišča notranjega premera zadnje stranice v polje ! stranice zunanjega premera brez zadnjih: do i=53,75 ST(i,1)=i ! grupiranje prvih oglišč stranic v polja ST(i,2)=i+1 ! grupiranje drugih oglišč enddo ST(76,1)=76 ! grupiranje prvega oglišča zun. premera zadnje stranice v polje ST(76,2)=53 ! grupiranje drugega oglišča zun. premera zadnje stranice v polje ! stranici dveh navpičnih črt ST(77,1)=33 ST(77,2)=51 ST(78,1)=39 ST(78,2)=45 ! stranice navoja do i=79,95 ST(i,1)=i ST(i,2)=i+1 enddo ! določitev stranic lokov, levi zgornji ST(96,1)=4 ST(96,2)=97 ST(97,1)=97 ST(97,2)=98 ST(98,1)=98 ST(98,2)=99 ST(99,1)=99 ST(99,2)=100 ST(100,1)=100 ST(100,2)=12 ! desni zgornji ST(101,1)=11 ST(101,2)=101 ST(102,1)=101 ST(102,2)=102 ST(103,1)=102 ST(103,2)=103 ST(104,1)=103 ST(104,2)=104 ST(105,1)=104 ST(105,2)=18 ! levi spodnji ST(106,1)=9 ST(106,2)=105 ST(107,1)=105 ST(107,2)=106 ST(108,1)=106 ST(108,2)=107 ST(109,1)=107 ST(109,2)=108 ST(110,1)=108 ST(110,2)=3 ! desni spodnji ST(111,1)=13 ST(111,2)=109 ST(112,1)=109 ST(112,2)=110 ST(113,1)=110 ST(113,2)=111 ST(114,1)=111 ST(114,2)=112 ST(115,1)=112 ST(115,2)=10 ! srednjice ST(116,1)=77 ST(116,2)=78 ST(117,1)=113 ST(117,2)=114 ST(118,1)=115 ST(118,2)=116 ! kotirnice ST(119,1)=117 ST(119,2)=118 ST(120,1)=117 ST(120,2)=119 ST(121,1)=117 ST(121,2)=120 ST(122,1)=120 ST(122,2)=121 ST(123,1)=120 ST(123,2)=122 ST(124,1)=123 ST(124,2)=124 ST(125,1)=123 ST(125,2)=125 ST(126,1)=123 ST(126,2)=126 ST(127,1)=126 ST(127,2)=127 ST(128,1)=126 ST(128,2)=128 ST(129,1)=1 ST(129,2)=117 ST(130,1)=15 ST(130,2)=120 ST(131,1)=17 ST(131,2)=123 ST(132,1)=14 ST(132,2)=126 !koordinatni sistem do i=1,4 ! št točk potrebnih za popis koordinatnega sistema do j=1,3 KS(i,j)=0 enddo enddo KS(2,1)=110 ! vrednost, ki jo zavzame posamezna točka koo. sistema KS(3,2)=50 ! vrednost, ki jo zavzame posamezna točka koo. sistema !KS(4,3)=5 ! vrednost, ki jo zavzame posamezna točka koo. sistema goto 44 10 write(*,*)' ' write(*,*)' ' write(*,*)' ' write(*,*)' ' write(*,*)' ' write(*,*)' ' write(*,*)' ' write(*,*)' ' write(*,*)' ' write(*,*)' ' write(*,*)' ' write(*,*)' ' write(*,*)' ' write(*,*)' ' write(*,*)' ' write(*,*)' ' write(*,*)' ' write(*,*)' ' write(*,*)' ' write(*,*)' ' write(*,*)'UPORABNIK NAJ IZBERE ENO OD SPODAJ NAVEDENIH OPERACIJ ' write(*,*)' ' write(*,*)'1 (skaliranje)' write(*,*)'2 (translacija)' write(*,*)'3 (rotacija okoli Z osi)' write(*,*)'4 (na zacetek programa)' write(*,*)'5 (izhod iz programa) ' read(*,*)operacija if (operacija.eq.1)then ! izvede skaliranje call skalirna(M) ! kliče skalirno matriko goto65 elseif(operacija.eq.2)then ! izvede translacijo call translacijska(M) ! kliče translacijsko matriko ! ________________TRANSLACIJA________________________ do i=1,n ! šteje vsa oglišča do j=1,2 vek(j)=OG(i,j) ! vektor privzame vrednosti posameznega oglišča enddo vek(3)=1 ! zadnje polje zavzame vrednost 1 call vzm(zmn,M,vek) ! kliče podprogram za množenje vektorja z matriko do j=1,2 OG(i,j)=zmn(j) ! oglišče privzame vrednosti produkta vektorja in matrike enddo enddo call pclear() goto 61 ! _______________SKALIRANJE____________________________ 65 do i=1,n ! šteje vsa oglišča do j=1,2 vek(j)=OG(i,j) ! vektor privzame vrednosti posameznega oglišča enddo vek(3)=1 ! zadnje polje zavzame vrednost 1 call vzm(zmn,M,vek) ! kliče podprogram za množenje vektorja z matriko do j=1,2 OG(i,j)=zmn(j) ! oglišče privzame vrednosti produkta vektorja in matrike enddo enddo call pclear() goto 61 ! __________________ROTACIJA______________________________ elseif(operacija.eq.3)then ! rotacija okoli z-osi write(*,*)'UPORABNIK NAJ PODA KOT V STOPINJAH OKOLI Z-OSI' read(*,*)fi ! bere kot call rotz(M,fi) ! kliče rotacijsko matriko okoli-z !izracun novih koordinat oglišč: do i=1,n ! šteje vasa oglišča do j=1,2 vek(j)=OG(i,j) ! vektor zavzave vrednosti posameznega oglišča enddo vek(3)=1 ! vrednost zadnjega polja je 1 call vzm(zmn,M,vek) ! kliče matriko za množenje vektorja z matriko do j=1,2 OG(i,j)=zmn(j) ! oglišča zavzamejo vrednosti produkta vektorja z matriko enddo enddo call pclear() goto 61 ! ________________________________________________________________ elseif(operacija.eq.4)then ! na zacetek programa call pclwk(1) !zapre delovno postajo call pclph() !zapre phigs(=graficni nacin) goto 20 elseif(operacija.eq.5)then goto 63 else stop ' Podatek je bil nepravilno vstavljen! ' endif ! določitev najbolj oddaljene točke: 44 maxto=0 do i=1,n do j=1,2 if (abs(OG(i,j)).gt.maxto) then maxto=abs(OG(i,j)) endif enddo enddo maxto=maxto*0.35 WindowLimits(1)=-maxto WindowLimits(2)=maxto WindowLimits(3)=-maxto WindowLimits(4)=maxto ! GRAFIKA call popph(1,0) !odprem PHIGS-knižnico call popwk(1,"",WK15800) !odpre delovno postajo call pevmm(WindowLimits, ViewportLimits, 1 ErrorReturn, ViewMappingMatrix) do 60 i=1,3 do 50 j=1,3 write(*,*) ViewMappingMatrix(i,j) 50 continue 60 continue 61 call pswkw(1,0.1,0.9,0.1,0.9) !nastavitev uporabniških koordinat call pswkv(1,0.0,0.1,0.0,0.1) !nastavitev zaslonskih koordinat !call psplci( ) !barva črte !barvni indeksi: !1=bela,2=rdeca,3=rumena !4=zelena,5=sv.modra,6=modra,7=viola,8=crna !RISANJE VSEH STRANIC V TLORISU IN NARISU: do l=1,5 ! št STRANIC kx(1)=OG(ST(l,1),1) !x koordinata prvega oglišča stranisc l ky(1)=OG(ST(l,1),2) !y koordinata drugega oglišča stranice l kx(2)=OG(ST(l,2),1) !x koordinata drugega oglišča stranice l ky(2)=OG(ST(l,2),2) !y koordinata drugega oglišča stranice l call psplci(5) !barva črte call ppl(2,kx,ky) !kličem izris črt enddo do l=6,7 kx(1)=OG(ST(l,1),1) ky(1)=OG(ST(l,1),2) kx(2)=OG(ST(l,2),1) ky(2)=OG(ST(l,2),2) call psplci(2) call ppl(2,kx,ky) enddo do l=8,20 kx(1)=OG(ST(l,1),1) ky(1)=OG(ST(l,1),2) kx(2)=OG(ST(l,2),1) ky(2)=OG(ST(l,2),2) call psplci(5) call ppl(2,kx,ky) enddo do l=21,22 kx(1)=OG(ST(l,1),1) ky(1)=OG(ST(l,1),2) kx(2)=OG(ST(l,2),1) ky(2)=OG(ST(l,2),2) call psplci(2) call ppl(2,kx,ky) enddo do l=23,78 kx(1)=OG(ST(l,1),1) ky(1)=OG(ST(l,1),2) kx(2)=OG(ST(l,2),1) ky(2)=OG(ST(l,2),2) call psplci(5) call ppl(2,kx,ky) enddo do l=79,95 kx(1)=OG(ST(l,1),1) ky(1)=OG(ST(l,1),2) kx(2)=OG(ST(l,2),1) ky(2)=OG(ST(l,2),2) call psplci(2) call ppl(2,kx,ky) enddo do l=96,115 kx(1)=OG(ST(l,1),1) ky(1)=OG(ST(l,1),2) kx(2)=OG(ST(l,2),1) ky(2)=OG(ST(l,2),2) call psplci(5) call ppl(2,kx,ky) enddo ! izris srednjice: do l=116,118 kx(1)=OG(ST(l,1),1) ky(1)=OG(ST(l,1),2) kx(2)=OG(ST(l,2),1) ky(2)=OG(ST(l,2),2) call psplci(6) call ppl(2,kx,ky) enddo ! izris kotirnic do l=119,132 kx(1)=OG(ST(l,1),1) ky(1)=OG(ST(l,1),2) kx(2)=OG(ST(l,2),1) ky(2)=OG(ST(l,2),2) call psplci(4) call ppl(2,kx,ky) enddo ! tekst na kotirnicah call pstxci(4) !izbrana barva glede na zgornji indeks call pschh(0.0060) !višina teksta call pstxal(0,0) call ptx(OG(129,1),OG(129,2), 'L') call ptx(OG(130,1),OG(130,2), ' d') !izris koordinatnega sistema: do j=2,4 ksx(1)=0 ksy(1)=0 ksx(2)=KS(j,1) ksy(2)=KS(j,2) call psplci(3) ! izbrana barva glede na zgornji indeks call ppl(2,ksx,ksy) ! klice izris črt koordinatnega sistema enddo !tekst koordinatnega sistema: call pstxci(3) !izbrana barva glede na zgornji indeks call pschh(0.0060) !višina teksta call pstxal(0,0) !poravnava call ptx(KS(3,1),KS(3,2), ' y') !izpis teksta call ptx(KS(2,1),KS(2,2), 'x') goto 10 63 call pclwk(1) !zapre delovno postajo call pclph() !zapre phigs(=graficni nacin) stop ' Program se je prekinil! ' !konec programa 1000 stop 'napaka pri odpiranju datoteke' 1100 format (A80) 1200 format (' ',A78,/,2x,I2,/,f7.2,/,f7.2) end ! _____________PODPROGRAMI______________________ !podprogram za izdelavo matrike za rotiranje okoli z osi !M je izhod, FI je vhod-kot zasuka okoli z osi v stopinjah subroutine rotz(Ms,FIs) real*4 Ms(3,3),FIRs,FIs FIRs=FIs*3.1415926/180.0 do i=1,3 do j=1,3 Ms(i,j)=0 enddo enddo !Ms(4,4)=1 Ms(3,3)=1 Ms(2,2)=cos(FIRs) Ms(2,1)=-sin(FIRs) Ms(1,2)=sin(FIRs) Ms(1,1)=cos(FIRs) return end !podprogram za mnozenje vektorja z matriko !a je izhod, M in b sta vhoda subroutine vzm(as,Ms,bs) real*4 apom,vsota,as,Ms,bs dimension as(3),bs(3),Ms(3,3) do j=1,3 vsota=0 do i=1,3 apom=bs(i)*Ms(i,j) vsota=vsota+apom !sestevam delne rezultate stolpcev enddo as(j)=vsota !vpisem sestevek v polje enddo return end subroutine skalirna(Mr) integer i,j real*4 Mr(3,3),sXi,sYi write(*,*)' ' write(*,*)' ' write(*,*)'UPORABNIK NAJ VNESE FAKTOR SKALIRANJA ' read(*,*)sXi ! program bere faktorje skaliranja sYi=sXi do i=1,3 do j=1,3 Mr(i,j)=0 enddo enddo Mr(1,1)=sXi Mr(2,2)=sYi Mr(3,3)=1 !Mr(4,4)=1 return end subroutine translacijska(Mi) real*4 Mi(3,3),dXi,dYi integer i,j write(*,*)' ' write(*,*)' ' write(*,*)'UPORABNIK NAJ VNESE FAKTORJE TRANSLACIJE V SMERI X,Y' read(*,*)dXi,dYi ! program bere faktorje translacije write(*,*)' ' write(*,*)' ' do i=1,3 do j=1,3 Mi(i,j)=0 enddo enddo Mi(1,1)=1 Mi(2,2)=1 Mi(3,3)=1 !Mi(4,4)=1 Mi(3,1)=dXi Mi(3,2)=dYi Mi(3,3)=1 return end