Télécharger pcyli.eso

Retour à la liste

Numérotation des lignes :

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

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