Télécharger rotvu.eso

Retour à la liste

Numérotation des lignes :

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales