Télécharger pcyli.eso

Retour à la liste

Numérotation des lignes :

  1. C PCYLI SOURCE CHAT 06/06/01 21:19:16 5450
  2. C CE SOUS-PROGRAMME RAMENNE UN CYLINDRE SUR SES COORDONNEES PROPRES
  3. C
  4. SUBROUTINE PCYLI(IOP,FER,XPROJ,NDEB,NUMNP,IP1,IP2,tcval,isens)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. -INC SMCOORD
  8. -INC CCOPTIO
  9. real*8 tcval(*)
  10. SEGMENT/FER/(NFI(ITT),MAI(IPP),ITOUR)
  11. SEGMENT XPROJ(3,IMAX)
  12. * tcval 1 2 3 4 5 6
  13. * SAVE XORIG,YORIG,ZORIG,XAXE,YAXE,ZAXE
  14. * tcval 7 8 9
  15. * SAVE XP1,YP1,ZP1
  16. * tcval 10
  17. * SAVE ISENS,RAYON
  18. IF (IOP.EQ.2) GOTO 100
  19. IMCT=MAI(ITOUR+1)
  20. INCT=MAI(1)+1
  21. IMAX=(IMCT**2)+10
  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 CYLINDRE
  28. IREF=IP1*4-3
  29. XP1=XCOOR(IREF)
  30. YP1=XCOOR(IREF+1)
  31. ZP1=XCOOR(IREF+2)
  32. tcval(7)=xp1
  33. tcval(8)=yp1
  34. tcval(9)=zp1
  35. IREF=IP2*4-3
  36. XP2=XCOOR(IREF)
  37. YP2=XCOOR(IREF+1)
  38. ZP2=XCOOR(IREF+2)
  39. XAXE=XP2-XP1
  40. YAXE=YP2-YP1
  41. ZAXE=ZP2-ZP1
  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 CYLINDRE
  52. IREF=4*NFI(IMCT)-3
  53. XV1=XCOOR(IREF)-XP1
  54. YV1=XCOOR(IREF+1)-YP1
  55. ZV1=XCOOR(IREF+2)-ZP1
  56. XI=XV1*XAXE+YV1*YAXE+ZV1*ZAXE
  57. XV1=XV1-XI*XAXE
  58. YV1=YV1-XI*YAXE
  59. ZV1=ZV1-XI*ZAXE
  60. IF (XV1**2+YV1**2+ZV1**2.EQ.0.) CALL ERREUR(21)
  61. IF (IERR.NE.0) RETURN
  62. XORIG=XV1
  63. YORIG=YV1
  64. ZORIG=ZV1
  65. tcval(1)=xorig
  66. tcval(2)=yorig
  67. tcval(3)=zorig
  68. RAYON=0
  69. COT=0
  70. DO 1 I=INCT,max(IMCT,mai(itour+2))
  71. II=NFI(I)
  72. IREF=4*II-3
  73. XV2=XCOOR(IREF)-XP1
  74. YV2=XCOOR(IREF+1)-YP1
  75. ZV2=XCOOR(IREF+2)-ZP1
  76. XPROJ(1,I)=XV2*XAXE+YV2*YAXE+ZV2*ZAXE
  77. XPROJ(3,I)=XCOOR(IREF+3)
  78. XI=XPROJ(1,I)
  79. XV2=XV2-XI*XAXE
  80. YV2=YV2-XI*YAXE
  81. ZV2=ZV2-XI*ZAXE
  82. R=XV2**2+YV2**2+ZV2**2
  83. IF (R.EQ.0..and.i.le.imct) CALL ERREUR(21)
  84. IF (IERR.NE.0) RETURN
  85. if (i.le.imct) RAYON=RAYON+R
  86. ANG=ATAN2(XAXE*(YV1*ZV2-YV2*ZV1)+YAXE*(ZV1*XV2-ZV2*XV1)+
  87. # ZAXE*(XV1*YV2-XV2*YV1),XV1*XV2+YV1*YV2+ZV1*ZV2)
  88. COT=COT+ANG
  89. XPROJ(2,I)=COT
  90. XV1=XV2
  91. YV1=YV2
  92. ZV1=ZV2
  93. 1 CONTINUE
  94. RAYON2=RAYON/(IMCT-INCT+1)
  95. RAYON=SQRT(RAYON2)
  96. tcval(10)=rayon
  97. DO 2 I=INCT,max(IMCT,mai(itour+2))
  98. XPROJ(2,I)=XPROJ(2,I)*RAYON
  99. II=NFI(I)
  100. NFI(I)=I
  101. IREF=4*II-3
  102. XV=XCOOR(IREF)-XP1
  103. YV=XCOOR(IREF+1)-YP1
  104. ZV=XCOOR(IREF+2)-ZP1
  105. SCAL=XV*XAXE+YV*YAXE+ZV*ZAXE
  106. XV=XV-SCAL*XAXE
  107. YV=YV-SCAL*YAXE
  108. ZV=ZV-SCAL*ZAXE
  109. RAY2=XV**2+YV**2+ZV**2
  110. RAP=RAY2/RAYON2
  111. IF ((RAP.GT.1.02.OR.RAP.LT.0.98).and.i.le.imct) CALL ERREUR(21)
  112. 2 CONTINUE
  113. C IL FAUT TOURNER DANS LE BON SENS
  114. SURF=0
  115. DO 3 IT=1,ITOUR
  116. II1=MAI(IT-1+1)+1
  117. II2=MAI(IT+1)
  118. XV1=XPROJ(1,II2)
  119. YV1=XPROJ(2,II2)
  120. DO 3 I=II1,II2
  121. XV2=XPROJ(1,I)
  122. YV2=XPROJ(2,I)
  123. IF (XPROJ(3,I).EQ.0.) XPROJ(3,I)=SQRT((XV2-XV1)**2+(YV2-YV1)**2)
  124. SURF=SURF+XV1*YV2-XV2*YV1
  125. XV1=XV2
  126. YV1=YV2
  127. 3 CONTINUE
  128. ISENS=1
  129. IF (SURF.GT.0.) GOTO 5
  130. ISENS=-1
  131. DO 4 I=INCT,max(IMCT,mai(itour+2))
  132. XPROJ(1,I)=-XPROJ(1,I)
  133. 4 CONTINUE
  134. 5 CONTINUE
  135. RETURN
  136. C TRANSFORMATION INVERSE
  137. 100 CONTINUE
  138. SEGACT MCOORD
  139. xorig=tcval(1)
  140. yorig=tcval(2)
  141. zorig=tcval(3)
  142. xaxe=tcval(4)
  143. yaxe=tcval(5)
  144. zaxe=tcval(6)
  145. xp1=tcval(7)
  146. yp1=tcval(8)
  147. zp1=tcval(9)
  148. rayon=tcval(10)
  149. XREP1=XORIG
  150. YREP1=YORIG
  151. ZREP1=ZORIG
  152. XREP2=YAXE*ZREP1-ZAXE*YREP1
  153. YREP2=ZAXE*XREP1-XAXE*ZREP1
  154. ZREP2=XAXE*YREP1-YAXE*XREP1
  155. IF (NUMNP.LT.NDEB) GOTO 102
  156. NBPTA=XCOOR(/1)/4
  157. NBPTS=NBPTA+NUMNP-NDEB+1
  158. SEGADJ MCOORD
  159. DO 101 I=NDEB,NUMNP
  160. Z=XPROJ(1,I)*ISENS
  161. ANG=XPROJ(2,I)/RAYON
  162. SI=SIN(ANG)
  163. CO=COS(ANG)
  164. XCOOR(NBPTA*4+1)=XREP1*CO+XREP2*SI+Z*XAXE+XP1
  165. XCOOR(NBPTA*4+2)=YREP1*CO+YREP2*SI+Z*YAXE+YP1
  166. XCOOR(NBPTA*4+3)=ZREP1*CO+ZREP2*SI+Z*ZAXE+ZP1
  167. XCOOR(NBPTA*4+4)=XPROJ(3,I)
  168. NBPTA=NBPTA+1
  169. 101 CONTINUE
  170. 102 CONTINUE
  171. SEGSUP XPROJ
  172. RETURN
  173. END
  174.  
  175.  
  176.  

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