Télécharger coupno.eso

Retour à la liste

Numérotation des lignes :

  1. C COUPNO SOURCE PV 11/10/07 21:15:12 7164
  2. subroutine coupno (xmi,xma,ymi,yma,zmi,zma,coupra,coupol)
  3. implicit integer(i-n)
  4. -INC SMCOORD
  5. -INC CCOPTIO
  6. dimension xtr(5),ytr(5),ztr(5)
  7.  
  8. ISORT = 0
  9. IRESU = 0
  10. call ini(IRESU,ISORT,0,0,0,0.,0.,0.,0.)
  11. xz=0d0
  12. xd=10d0
  13. xv=20d0
  14. call dfenet(xz,xd,xz,xv,xz,xd,xz,xd,xz,xv,.false.)
  15. xtr(1)=2.
  16. xtr(2)=8.
  17. xtr(3)=8.
  18. xtr(4)=2.
  19. xtr(5)=xtr(1)
  20. ytr(1)=7.
  21. ytr(2)=7.
  22. ytr(3)=7.3
  23. ytr(4)=7.3
  24. ytr(5)=ytr(1)
  25. ztr(1)=0.1
  26. ztr(2)=0.1
  27. ztr(3)=0.1
  28. ztr(4)=0.1
  29. ztr(5)=0.1
  30.  
  31. call majseg(1,0,0,0,0)
  32. call insegt(1,ires)
  33. call trmess(' <-- proche : lointain --> ')
  34. call chcoul(0)
  35. call polrl(5,xtr,ytr,ztr)
  36. * indiquer la position courante
  37. if( coupol.ge.0.) then
  38. xtr(1)=xtr(1)+ ( xtr(3)-xtr(1))*coupol- 6. / 100.
  39. ytr(1)= 7.05
  40. xtr(2)=xtr(1)+ 6. / 100.
  41. ytr(2)=ytr(1)
  42. xtr(3)=xtr(2)
  43. ytr(3)=7.25
  44. xtr(4)=xtr(1)
  45. ytr(4)=ytr(3)
  46. xtr(5)=xtr(1)
  47. ytr(5)=ytr(1)
  48. call polrl(5,xtr,ytr,ztr)
  49. endif
  50. rxpos=0.
  51. rypos=0.
  52. if( iogra.ne.6) then
  53. call trdig (rxpos,rypos,inouse)
  54. else
  55. call otrdig (rxpos,rypos,inouse)
  56. endif
  57. coupra=(rxpos-2.) / 6.
  58. if( coupra.le.0.) coupra=0.01
  59. if(coupra.ge.1.) coupra=0.99
  60. * write(6,*) ' coupra ',coupra
  61. if( coupra . lt. 0.)coupra=0.01
  62. if( coupra . ge . 1.) coupra = 0.99
  63. coupol=coupra
  64. return
  65.  
  66. *
  67. end
  68.  
  69.  
  70.  
  71.  
  72.  

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