Télécharger la plaquette Cast3M


fr en

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