1 : C ROTVU SOURCE CHAT 11/09/30 21:15:26 7148 2 : SUBROUTINE ROTVU(IOEINI,IOEIL,CGRAV,XMI,XMA,YMI,YMA,zmi,zma,axez) 3 : IMPLICIT INTEGER(I-N) 4 : -inc CCOPTIO 5 : -inc SMCOORD 6 : * 7 : dimension cgrav(3),cold(3),dir(3),cnew(3),axez(*) 8 : dimension cini(3),dirz(3) 9 : character*13 legend(1) 10 : real*8 xa(3),xo(3),xn(3),xb(3),si,co 11 : dimension xtr(40),ytr(40),ztr(40) 12 : integer ieff 13 : * 14 : pi=4.*atan(1.) 15 : * 16 : * affichage du nouveau menu 17 : * 18 : cold(1)=xcoor((idim+1)*(ioeil-1)+1)-cgrav(1) 19 : cold(2)=xcoor((idim+1)*(ioeil-1)+2)-cgrav(2) 20 : cold(3)=xcoor((idim+1)*(ioeil-1)+3)-cgrav(3) 21 : cini(1)=xcoor((idim+1)*(ioeini-1)+1)-cgrav(1) 22 : cini(2)=xcoor((idim+1)*(ioeini-1)+2)-cgrav(2) 23 : cini(3)=xcoor((idim+1)*(ioeini-1)+3)-cgrav(3) 24 : dini=sqrt(cini(1)**2+cini(2)**2+cini(3)**2) 25 : xmil=(xma+xmi)/2. 26 : ymil=(yma+ymi)/2. 27 : rayx=(xma-xmi)/10. 28 : rayy=(yma-ymi)/10. 29 : ray=max(rayx,rayy) 30 : xdig=xmil 31 : ydig=ymil 32 : zdig=1e30 33 : legend(1)='Fin operation' 34 : ncase=1 35 : llong=13 36 : 37 : if(iogra.ne.6) then 37 : call menu(legend,ncase,llong) 37 : call trmess('Donnez le nouveau point de vue') 37 : call insegt(8,iresu) 38 : zcot=zmi-(zma-zmi)*0.05 39 : do ii=1,40 40 : ztr(ii)=zcot 41 : enddo 42 : * write (6,*) ' zcot dans rotvu ', zcot 43 : xtr(1)=xmil-ray 44 : ytr(1)=ymil-ray 45 : xtr(2)=xmil+ray 46 : ytr(2)=ymil-ray 47 : xtr(3)=xmil+ray 48 : ytr(3)=ymil+ray 49 : xtr(4)=xmil-ray 50 : ytr(4)=ymil+ray 51 : xtr(5)=xtr(1) 52 : ytr(5)=ytr(1) 52 : call trface(5,xtr,ytr,ztr,1.,8,ieff) 52 : call chcoul(7) 52 : call polrl(5,xtr,ytr,ztr) 53 : xtr(1)=xmil-ray 54 : ytr(1)=ymil-ray/1.414 55 : xtr(2)=xmil+ray 56 : ytr(2)=ymil-ray/1.414 56 : call polrl(2,xtr,ytr,ztr) 57 : xtr(1)=xmil-ray 58 : ytr(1)=ymil 59 : xtr(2)=xmil+ray 60 : ytr(2)=ymil 60 : call polrl(2,xtr,ytr,ztr) 61 : xtr(1)=xmil-ray 62 : ytr(1)=ymil+ray/1.414 63 : xtr(2)=xmil+ray 64 : ytr(2)=ymil+ray/1.414 64 : call polrl(2,xtr,ytr,ztr) 65 : xtr(1)=xmil-ray/2 66 : ytr(1)=ymil-ray 67 : xtr(2)=xmil-ray/2 68 : ytr(2)=ymil+ray 68 : call polrl(2,xtr,ytr,ztr) 69 : xtr(1)=xmil 70 : ytr(1)=ymil-ray 71 : xtr(2)=xmil 72 : ytr(2)=ymil+ray 72 : call polrl(2,xtr,ytr,ztr) 73 : xtr(1)=xmil+ray/2 74 : ytr(1)=ymil-ray 75 : xtr(2)=xmil+ray/2 76 : ytr(2)=ymil+ray 76 : call polrl(2,xtr,ytr,ztr) 77 : * 78 : * indiquer l'oeil courant 79 : * 80 : cold(1)=xcoor((idim+1)*(ioeil-1)+1)-cgrav(1) 81 : cold(2)=xcoor((idim+1)*(ioeil-1)+2)-cgrav(2) 82 : cold(3)=xcoor((idim+1)*(ioeil-1)+3)-cgrav(3) 83 : cini(1)=xcoor((idim+1)*(ioeini-1)+1)-cgrav(1) 84 : cini(2)=xcoor((idim+1)*(ioeini-1)+2)-cgrav(2) 85 : cini(3)=xcoor((idim+1)*(ioeini-1)+3)-cgrav(3) 86 : dini=sqrt(cini(1)**2+cini(2)**2+cini(3)**2) 87 : haut=atan2(cold(3),sqrt(cold(1)**2+cold(2)**2)) 88 : haut=haut*ray/(pi/2) 89 : posi=atan2(cini(2),cini(1)) 90 : poso=atan2(cold(2),cold(1)) 91 : poso=mod(poso-posi+pi,2*pi)-pi 92 : poso=poso*ray/pi 93 : xtr(1)=xmil+poso-ray/50 94 : ytr(1)=ymil+haut-ray/50 95 : xtr(2)=xmil+poso+ray/50 96 : ytr(2)=ymil+haut-ray/50 97 : xtr(3)=xmil+poso+ray/50 98 : ytr(3)=ymil+haut+ray/50 99 : xtr(4)=xmil+poso-ray/50 100 : ytr(4)=ymil+haut+ray/50 101 : xtr(5)=xtr(1) 102 : ytr(5)=ytr(1) 102 : call polrl(5,xtr,ytr,ztr) 103 : xdig=xmil 104 : ydig=ymil 105 : zdig=1e30 106 : * if(iogra.ne.6) then 106 : call trdig(xdig,ydig,icle) 107 : dir(1)=(xdig-xmil)/ray 108 : dir(2)=(ydig-ymil)/ray 109 : dir(1)=sign(min(1.,abs(dir(1))),dir(1))*pi 110 : dir(2)=sign(min(1.,abs(dir(2))),dir(2))*(pi/2) 111 : cnew(1)=cini(1)*cos(dir(1))-cini(2)*sin(dir(1)) 112 : cnew(2)=cini(1)*sin(dir(1))+cini(2)*cos(dir(1)) 113 : dpar=sqrt(cnew(1)**2+cnew(2)**2) 114 : cnew(1)=cnew(1)*cos(dir(2))*dini/dpar 115 : cnew(2)=cnew(2)*cos(dir(2))*dini/dpar 116 : cnew(3)=sin(dir(2))*dpar 117 : nbpts=xcoor(/1)/(idim+1)+1 118 : segadj mcoord 119 : xcoor((idim+1)*(nbpts-1)+1)=cnew(1)+cgrav(1) 120 : xcoor((idim+1)*(nbpts-1)+2)=cnew(2)+cgrav(2) 121 : xcoor((idim+1)*(nbpts-1)+3)=cnew(3)+cgrav(3) 122 : ioeil=nbpts 123 : 124 : 125 : return 126 : endif 127 : if (iogra.eq.6) then 127 : call menu(legend,ncase,llong) 127 : call trmess('Appuyer sur click gauche et faites tourner') 127 : call insegt(8,iresu) 128 : * cas opengl 129 : * write (6,*) ' entree trdig xdig ydig zdig ',xdig,ydig,zdig 129 : call otrdigro(xdig,ydig,zdig,axez(1),axez(2),axez(3)) 130 : * write (6,*) ' retour de trdig xdig ydig zdig ',xdig,ydig,zdig 131 : nbpts=xcoor(/1)/(idim+1)+1 132 : segadj mcoord 133 : xdig=xdig-cgrav(1) 134 : ydig=ydig-cgrav(2) 135 : zdig=zdig-cgrav(3) 136 : xl=sqrt(xdig**2.D0+ydig**2.D0+zdig**2.D0) 137 : xdig=xdig/xl 138 : ydig=ydig/xl 139 : zdig=zdig/xl 140 : dirz(1)=cold(1) 141 : dirz(2)=cold(2) 142 : dirz(3)=cold(3) 143 : ddirz=sqrt(dirz(1)**2+dirz(2)**2+dirz(3)**2) 144 : dirz(1)=dirz(1)/ddirz 145 : dirz(2)=dirz(2)/ddirz 146 : dirz(3)=dirz(3)/ddirz 147 : * write (6,*) ' dirz ',dirz(1),dirz(2),dirz(3) 148 : * write (6,*) ' cold ',cold(1),cold(2),cold(3) 149 : * rotation axe z 150 : xa(1)=-dirz(3)*dirz(1) 151 : xa(2)=-dirz(3)*dirz(2) 152 : xa(3)=dirz(1)**2+dirz(2)**2 153 : da=sqrt(xa(1)**2+xa(2)**2+xa(3)**2) 154 : xa(1)=xa(1)/da 155 : xa(2)=xa(2)/da 156 : xa(3)=xa(3)/da 157 : xo(1)=cold(1) 158 : xo(2)=cold(2) 159 : xo(3)=cold(3) 160 : pdig=sqrt(xdig**2+zdig**2) 161 : si=-xdig/pdig 162 : co=zdig/pdig 162 : call rot3d(xa,si,co,xo,xn) 163 : * write (6,*) 'xn ',xn(1),xn(2),xn(3) 164 : * write (6,*) ' rot z si co ',si,co 165 : * rotation Oxy (perpendiculaire à axez(1) axez(2) 166 : ddirz=sqrt(dirz(1)**2+dirz(2)**2) 167 : dirz(1)=dirz(1)/ddirz 168 : dirz(2)=dirz(2)/ddirz 169 : dirz(3)=dirz(3)/ddirz 170 : xo(1)=-dirz(2) 171 : xo(2)=dirz(1) 172 : xo(3)=0 172 : call rot3d(xa,si,co,xo,xb) 173 : xa(1)=xb(1) 174 : xa(2)=xb(2) 175 : xa(3)=xb(3) 176 : xo(1)=xn(1) 177 : xo(2)=xn(2) 178 : xo(3)=xn(3) 179 : zzdig=sqrt(ydig**2+pdig**2) 180 : si=ydig/zzdig 181 : co=pdig/zzdig 182 : * write (6,*) ' rot Oxy si co ',si,co 182 : call rot3d(xa,si,co,xo,xn) 183 : * write (6,*) ' 2-xn ',xn(1),xn(2),xn(3) 184 : xcoor((idim+1)*(nbpts-1)+1)=xn(1)+cgrav(1) 185 : xcoor((idim+1)*(nbpts-1)+2)=xn(2)+cgrav(2) 186 : xcoor((idim+1)*(nbpts-1)+3)=xn(3)+cgrav(3) 187 : 188 : 189 : * write (6,*) '1 cold ',cold(1),cold(2),cold(3) 190 : 191 : ioeil=nbpts 192 : return 193 : endif 194 : * 195 : end 196 : 197 : 198 : 199 : 200 : 201 : 202 :
© Cast3M 2003 - All rights reserved.
Disclaimer