Télécharger pcone.eso

Retour à la liste

Numérotation des lignes :

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

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