Télécharger pcone.eso

Retour à la liste

Numérotation des lignes :

  1. C PCONE SOURCE CHAT 06/06/01 21:19:10 5450
  2. C CE SOUS-PROGRAMME RAMENNE UN CONE SUR SES COORDONNEES PROPRES
  3. C
  4. SUBROUTINE PCONE(IOP,FER,XPROJ,NDEB,NUMNP,ISOM,IP2,tcval,isens)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. -INC SMCOORD
  8. -INC CCOPTIO
  9. SEGMENT/FER/(NFI(ITT),MAI(IPP),ITOUR)
  10. SEGMENT XPROJ(3,IMAX)
  11. real*8 tcval(*)
  12. * tcval(1) 2 3 4 5 6 7
  13. * SAVE XORIG,YORIG,ZORIG,XAXE,YAXE,ZAXE,ISENS,SANGS
  14. * tcval(8) 9 10 11
  15. * SAVE XSOM,YSOM,ZSOM,CANGS
  16. IF (IOP.EQ.2) GOTO 100
  17. IMCT=MAI(ITOUR+1)
  18. INCT=MAI(1)+1
  19. IMAX=IMCT**2
  20. CALL LIRENT(IMAX,0,IRETOU)
  21. IF (IRETOU.NE.0) IMAX=MAX(1,IMAX)
  22. NDEB=IMCT+1
  23. SEGINI XPROJ
  24. SEGACT MCOORD
  25. C AXE DU CONE
  26. IREF=ISOM*4-3
  27. XSOM=XCOOR(IREF)
  28. YSOM=XCOOR(IREF+1)
  29. ZSOM=XCOOR(IREF+2)
  30. tcval(8)=xsom
  31. tcval(9)=ysom
  32. tcval(10)=Zsom
  33. IREF=IP2*4-3
  34. XP2=XCOOR(IREF)
  35. YP2=XCOOR(IREF+1)
  36. ZP2=XCOOR(IREF+2)
  37. XAXE=XP2-XSOM
  38. YAXE=YP2-YSOM
  39. ZAXE=ZP2-ZSOM
  40. DAXE=SQRT(XAXE**2+YAXE**2+ZAXE**2)
  41. IF (DAXE.EQ.0.) CALL ERREUR(21)
  42. IF (IERR.NE.0) RETURN
  43. XAXE=XAXE/DAXE
  44. YAXE=YAXE/DAXE
  45. ZAXE=ZAXE/DAXE
  46. tcval(4)=xaxe
  47. tcval(5)=yaxe
  48. tcval(6)=zaxe
  49. C DEROULONS LE CONE
  50. IREF=4*NFI(IMCT)-3
  51. XV1=XCOOR(IREF)-XSOM
  52. YV1=XCOOR(IREF+1)-YSOM
  53. ZV1=XCOOR(IREF+2)-ZSOM
  54. PV1=XV1*XAXE+YV1*YAXE+ZV1*ZAXE
  55. XV1=XV1-PV1*XAXE
  56. YV1=YV1-PV1*YAXE
  57. ZV1=ZV1-PV1*ZAXE
  58. DV1=SQRT(XV1**2+YV1**2+ZV1**2)
  59. IF (DV1.EQ.0.) CALL ERREUR(21)
  60. IF (IERR.NE.0) RETURN
  61. XV1=XV1/DV1
  62. YV1=YV1/DV1
  63. ZV1=ZV1/DV1
  64. XORIG=XV1
  65. YORIG=YV1
  66. ZORIG=ZV1
  67. tcval(1)=xorig
  68. tcval(2)=yorig
  69. tcval(3)=zorig
  70. ANGSOM=0
  71. COT=0
  72. DO 1 I=INCT,max(IMCT,mai(itour+2))
  73. II=NFI(I)
  74. IREF=4*II-3
  75. XV2=XCOOR(IREF)-XSOM
  76. YV2=XCOOR(IREF+1)-YSOM
  77. ZV2=XCOOR(IREF+2)-ZSOM
  78. XPROJ(1,I)=SQRT(XV2**2+YV2**2+ZV2**2)
  79. XPROJ(3,I)=XCOOR(IREF+3)
  80. XI=XPROJ(1,I)
  81. C XI EST LE RAYON EN COORDONNEES POLAIRES QU'EST L'ANGLE?
  82. PROJ=XV2*XAXE+YV2*YAXE+ZV2*ZAXE
  83. if (i.le.imct) ANGSOM=ANGSOM+PROJ/XI
  84. XV2=XV2-PROJ*XAXE
  85. YV2=YV2-PROJ*YAXE
  86. ZV2=ZV2-PROJ*ZAXE
  87. DV2=SQRT(XV2**2+YV2**2+ZV2**2)
  88. IF (i.le.imct.and.DV2.EQ.0.) CALL ERREUR(21)
  89. IF (IERR.NE.0) RETURN
  90. XV2=XV2/DV2
  91. YV2=YV2/DV2
  92. ZV2=ZV2/DV2
  93. ANG=ATAN2(XAXE*(YV1*ZV2-ZV1*YV2)+YAXE*(ZV1*XV2-XV1*ZV2)+ZAXE*
  94. # (XV1*YV2-YV1*XV2),XV1*XV2+YV1*YV2+ZV1*ZV2)
  95. COT=COT+ANG
  96. XPROJ(2,I)=COT
  97. XV1=XV2
  98. YV1=YV2
  99. ZV1=ZV2
  100. 1 CONTINUE
  101. CANGS=ANGSOM/(IMCT-INCT+1)
  102. SANGS=SQRT(1-CANGS**2)
  103. tcval(7)=sangs
  104. tcval(11)=cangs
  105. DO 2 I=INCT,max(IMCT,mai(itour+2))
  106. XPROJ(2,I)=XPROJ(2,I)*SANGS
  107. RR=XPROJ(1,I)
  108. XPROJ(1,I)=RR*COS(XPROJ(2,I))
  109. XPROJ(2,I)=RR*SIN(XPROJ(2,I))
  110. II=NFI(I)
  111. NFI(I)=I
  112. IREF=4*II-3
  113. XV=XCOOR(IREF)-XSOM
  114. YV=XCOOR(IREF+1)-YSOM
  115. ZV=XCOOR(IREF+2)-ZSOM
  116. SCAL=XV*XAXE+YV*YAXE+ZV*ZAXE
  117. DV=SQRT(XV**2+YV**2+ZV**2)
  118. CAN=SCAL/DV
  119. RAP=CANGS/CAN
  120. IF (i.le.imct.and.(RAP.GT.1.01.OR.RAP.LT.0.99)) CALL ERREUR(21)
  121. 2 CONTINUE
  122. C IL FAUT TOURNER DANS LE BON SENS
  123. SURF=0
  124. DO 3 IT=1,ITOUR
  125. II1=MAI(IT-1+1)+1
  126. II2=MAI(IT+1)
  127. XV1=XPROJ(1,II2)
  128. YV1=XPROJ(2,II2)
  129. DO 3 I=II1,II2
  130. XV2=XPROJ(1,I)
  131. YV2=XPROJ(2,I)
  132. IF (XPROJ(3,I).EQ.0) XPROJ(3,I)=SQRT((XV2-XV1)**2+(YV2-YV1)**2)
  133. SURF=SURF+XV1*YV2-XV2*YV1
  134. XV1=XV2
  135. YV1=YV2
  136. 3 CONTINUE
  137. ISENS=1
  138. IF (SURF.GT.0.) GOTO 5
  139. ISENS=-1
  140. DO 4 I=INCT,max(IMCT,mai(itour+2))
  141. XPROJ(1,I)=-XPROJ(1,I)
  142. 4 CONTINUE
  143. 5 CONTINUE
  144. RETURN
  145. C TRANSFORMATION INVERSE
  146. 100 CONTINUE
  147. xorig=tcval(1)
  148. yorig=tcval(2)
  149. zorig=tcval(3)
  150. xaxe=tcval(4)
  151. yaxe=tcval(5)
  152. zaxe=tcval(6)
  153. sangs=tcval(7)
  154. xsom=tcval(8)
  155. ysom=tcval(9)
  156. zsom=tcval(10)
  157. cangs=tcval(11)
  158. SEGACT MCOORD
  159. XREP1=XORIG
  160. YREP1=YORIG
  161. ZREP1=ZORIG
  162. XREP2=YAXE*ZREP1-ZAXE*YREP1
  163. YREP2=ZAXE*XREP1-XAXE*ZREP1
  164. ZREP2=XAXE*YREP1-YAXE*XREP1
  165. IF (NUMNP.LT.NDEB) GOTO 102
  166. NBPTA=XCOOR(/1)/4
  167. NBPTS=NBPTA+NUMNP-NDEB+1
  168. SEGADJ MCOORD
  169. DO 101 I=NDEB,NUMNP
  170. R=SQRT(XPROJ(1,I)**2+XPROJ(2,I)**2)
  171. IF (R.EQ.0.) CALL ERREUR(21)
  172. IF (IERR.NE.0.) RETURN
  173. ANG=ATAN2(XPROJ(2,I),XPROJ(1,I)*ISENS)
  174. XPROJ(1,I)=R
  175. XPROJ(2,I)=ANG/SANGS
  176. SI=SIN(XPROJ(2,I))
  177. CO=COS(XPROJ(2,I))
  178. XCOOR(NBPTA*4+1)=(XREP1*CO+XREP2*SI)*R*SANGS+R*CANGS*XAXE+XSOM
  179. XCOOR(NBPTA*4+2)=(YREP1*CO+YREP2*SI)*R*SANGS+R*CANGS*YAXE+YSOM
  180. XCOOR(NBPTA*4+3)=(ZREP1*CO+ZREP2*SI)*R*SANGS+R*CANGS*ZAXE+ZSOM
  181. XCOOR(NBPTA*4+4)=XPROJ(3,I)
  182. NBPTA=NBPTA+1
  183. 101 CONTINUE
  184. 102 CONTINUE
  185. SEGSUP XPROJ
  186. RETURN
  187. END
  188.  
  189.  
  190.  

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