Télécharger promod.eso

Retour à la liste

Numérotation des lignes :

  1. C PROMOD SOURCE PV 20/03/24 21:20:28 10554
  2. C PROJECTION SPECIALE POUR MODI
  3. SUBROUTINE PROMOD(ICPR,XPROJ,IOEIL,ICLE,IBOUJ)
  4. IMPLICIT INTEGER(I-N)
  5. -INC SMCOORD
  6.  
  7. -INC PPARAM
  8. -INC CCOPTIO
  9. SEGMENT ICPR(0)
  10. SEGMENT IBOUJ(ITE)
  11. SEGMENT XPROJ(3,0)
  12. DIMENSION XBAR(3),OEIL(3),XMAT(3,3),XINT(3),YINT(3)
  13. SAVE XBAR,XMAT,RPREC
  14. ITE=ICPR(/1)
  15. SEGADJ IBOUJ
  16. IF (ICLE.NE.1) GOTO 100
  17. IF (IDIM.EQ.2) THEN
  18. DO 10 I=1,ICPR(/1)
  19. IP=ICPR(I)
  20. IF (IP.EQ.0) GOTO 10
  21. IREF=(IDIM+1)*(I-1)
  22. DO 20 J=1,2
  23. XPROJ(J,IP)=XCOOR(IREF+J)
  24. 20 CONTINUE
  25. XPROJ(J,IP)=0.
  26. 10 CONTINUE
  27. RETURN
  28. ENDIF
  29. * CALCUL DE LA MATRICE DE PROJECTION
  30. * RECHERCHE DU BARYCENTRE GENERAL
  31. RPREC=0.
  32. XBAR(1)=0.
  33. XBAR(2)=0.
  34. XBAR(3)=0.
  35. NP=0
  36. DO 30 I=1,ICPR(/1)
  37. IP=ICPR(I)
  38. IF (IP.EQ.0) GOTO 30
  39. NP=NP+1
  40. IREF=(IDIM+1)*(I-1)
  41. DO 50 J=1,3
  42. XXX=XCOOR(IREF+J)
  43. RPREC=MAX(RPREC,ABS(XXX))
  44. XBAR(J)=XXX+XBAR(J)
  45. 50 CONTINUE
  46. 30 CONTINUE
  47. RPREC=RPREC*1E-5
  48. XBAR(1)=XBAR(1)/NP
  49. XBAR(2)=XBAR(2)/NP
  50. XBAR(3)=XBAR(3)/NP
  51. * OEIL
  52. IREF=(IDIM+1)*(IOEIL-1)
  53. OEIL(1)=XCOOR(IREF+1)
  54. OEIL(2)=XCOOR(IREF+2)
  55. OEIL(3)=XCOOR(IREF+3)
  56. XMAT(1,3)=OEIL(1)-XBAR(1)
  57. XMAT(2,3)=OEIL(2)-XBAR(2)
  58. XMAT(3,3)=OEIL(3)-XBAR(3)
  59. SMAT=SQRT(XMAT(1,3)**2+XMAT(2,3)**2+XMAT(3,3)**2)
  60. IF (SMAT.EQ.0.) CALL ERREUR(21)
  61. IF (IERR.NE.0) RETURN
  62. XMAT(1,3)=XMAT(1,3)/SMAT
  63. XMAT(2,3)=XMAT(2,3)/SMAT
  64. XMAT(3,3)=XMAT(3,3)/SMAT
  65. SEGAct MCOORD*mod
  66. NBPTS=nbpts+1
  67. SEGADJ MCOORD
  68. XCOOR((NBPTS-1)*4+1)=XMAT(1,3)
  69. XCOOR((NBPTS-1)*4+2)=XMAT(2,3)
  70. XCOOR((NBPTS-1)*4+3)=XMAT(3,3)
  71. XCOOR((NBPTS-1)*4+4)=1.
  72. ICPR(**)=0
  73. * AXE DES Z DONNE AXE DES Y
  74. ZCOMP=XMAT(3,3)
  75. XMAT(1,2)= (0.-XMAT(1,3)*ZCOMP)
  76. XMAT(2,2)= (0.-XMAT(2,3)*ZCOMP)
  77. XMAT(3,2)= (1.-XMAT(3,3)*ZCOMP)
  78. SMAT=SQRT(XMAT(1,2)**2+XMAT(2,2)**2+XMAT(3,2)**2)
  79. * SI PAS POSSIBLE PRENDRE AXE Y
  80. IF (SMAT.LE.0.1) THEN
  81. YCOMP=XMAT(2,3)
  82. XMAT(1,2)= (0.-XMAT(1,3)*YCOMP)
  83. XMAT(2,2)= (1.-XMAT(2,3)*YCOMP)
  84. XMAT(3,2)= (0.-XMAT(3,3)*YCOMP)
  85. SMAT=SQRT(XMAT(1,2)**2+XMAT(2,2)**2+XMAT(3,2)**2)
  86. ENDIF
  87. XMAT(1,2)=XMAT(1,2)/SMAT
  88. XMAT(2,2)=XMAT(2,2)/SMAT
  89. XMAT(3,2)=XMAT(3,2)/SMAT
  90. * TROISIEME VECTEUR
  91. XMAT(1,1)= (XMAT(2,2)*XMAT(3,3)-XMAT(3,2)*XMAT(2,3))
  92. XMAT(2,1)= (XMAT(3,2)*XMAT(1,3)-XMAT(1,2)*XMAT(3,3))
  93. XMAT(3,1)= (XMAT(1,2)*XMAT(2,3)-XMAT(2,2)*XMAT(1,3))
  94. * PROJECTION
  95. DO 40 I=1,ICPR(/1)
  96. IP=ICPR(I)
  97. IF (IP.EQ.0) GOTO 40
  98. IREF=(IDIM+1)*(I-1)
  99. XINT(1)=XCOOR(IREF+1)-XBAR(1)
  100. XINT(2)=XCOOR(IREF+2)-XBAR(2)
  101. XINT(3)=XCOOR(IREF+3)-XBAR(3)
  102. XPROJ(1,IP)=XINT(1)*XMAT(1,1)+XINT(2)*XMAT(2,1)+XINT(3)*XMAT(3,1)
  103. XPROJ(2,IP)=XINT(1)*XMAT(1,2)+XINT(2)*XMAT(2,2)+XINT(3)*XMAT(3,2)
  104. XPROJ(3,IP)=XINT(1)*XMAT(1,3)+XINT(2)*XMAT(2,3)+XINT(3)*XMAT(3,3)
  105. XPROJ(3,IP)=-XPROJ(3,IP)
  106. 40 CONTINUE
  107. RETURN
  108. 100 CONTINUE
  109. IF (ICLE.NE.2) GOTO 200
  110. IF (IDIM.EQ.2) THEN
  111. DO 110 I=1,ICPR(/1)
  112. IP=ICPR(I)
  113. IF (IP.EQ.0) GOTO 110
  114. IREF=(IDIM+1)*(I-1)
  115. DO 120 J=1,2
  116. XCOOR(IREF+J)=XPROJ(J,IP)
  117. 120 CONTINUE
  118. 110 CONTINUE
  119. RETURN
  120. ENDIF
  121. * DEPROJECTION
  122. DO 140 I=1,ICPR(/1)
  123. IP=ICPR(I)
  124. IF (IP.EQ.0) GOTO 140
  125. IREF=(IDIM+1)*(I-1)
  126. YINT(1)=XPROJ(1,IP)
  127. YINT(2)=XPROJ(2,IP)
  128. YINT(3)=-XPROJ(3,IP)
  129. XINT(1)=YINT(1)*XMAT(1,1)+YINT(2)*XMAT(1,2)+YINT(3)*XMAT(1,3)
  130. XINT(2)=YINT(1)*XMAT(2,1)+YINT(2)*XMAT(2,2)+YINT(3)*XMAT(2,3)
  131. XINT(3)=YINT(1)*XMAT(3,1)+YINT(2)*XMAT(3,2)+YINT(3)*XMAT(3,3)
  132. XINT(1)=XINT(1)+XBAR(1)
  133. XINT(2)=XINT(2)+XBAR(2)
  134. XINT(3)=XINT(3)+XBAR(3)
  135. IF (ABS(XINT(1)-XCOOR(1+IREF)).GE.RPREC.OR.
  136. # ABS(XINT(2)-XCOOR(2+IREF)).GE.RPREC.OR.
  137. # ABS(XINT(3)-XCOOR(3+IREF)).GE.RPREC) THEN
  138. XCOOR(1+IREF)=XINT(1)
  139. XCOOR(2+IREF)=XINT(2)
  140. XCOOR(3+IREF)=XINT(3)
  141. IBOUJ(IP)=1
  142. ENDIF
  143. 140 CONTINUE
  144. RETURN
  145. 200 CONTINUE
  146. IF (ICLE.NE.3) GOTO 300
  147. IF (IDIM.EQ.2) THEN
  148. IPP=ICPR(IOEIL)
  149. IREF=(IDIM+1)*(IOEIL-1)
  150. DO 210 J=1,2
  151. XPROJ(J,IPP)=XCOOR(IREF+J)
  152. 210 CONTINUE
  153. RETURN
  154. ENDIF
  155. * REPROJECTION DU POINT IOEIL (NON CE N'EST PAS LE MEME)
  156. IP=ICPR(IOEIL)
  157. IF (IP.EQ.0) RETURN
  158. IREF=(IDIM+1)*(IOEIL-1)
  159. XINT(1)=XCOOR(IREF+1)-XBAR(1)
  160. XINT(2)=XCOOR(IREF+2)-XBAR(2)
  161. XINT(3)=XCOOR(IREF+3)-XBAR(3)
  162. XPROJ(1,IP)=XINT(1)*XMAT(1,1)+XINT(2)*XMAT(2,1)+XINT(3)*XMAT(3,1)
  163. XPROJ(2,IP)=XINT(1)*XMAT(1,2)+XINT(2)*XMAT(2,2)+XINT(3)*XMAT(3,2)
  164. XPROJ(3,IP)=XINT(1)*XMAT(1,3)+XINT(2)*XMAT(2,3)+XINT(3)*XMAT(3,3)
  165. XPROJ(3,IP)=-XPROJ(3,IP)
  166. RETURN
  167. 300 CONTINUE
  168. IF (IDIM.EQ.2) THEN
  169. IPP=ICPR(IOEIL)
  170. IREF=(IDIM+1)*(IOEIL-1)
  171. DO 310 J=1,2
  172. XCOOR(IREF+J)=XPROJ(J,IPP)
  173. 310 CONTINUE
  174. RETURN
  175. ENDIF
  176. * DEPROJECTION DU POINT IOEIL (NON CE N'EST PAS LE MEME)
  177. IP=ICPR(IOEIL)
  178. IF (IP.EQ.0) RETURN
  179. IREF=(IDIM+1)*(IOEIL-1)
  180. YINT(1)=XPROJ(1,IP)
  181. YINT(2)=XPROJ(2,IP)
  182. YINT(3)=-XPROJ(3,IP)
  183. XINT(1)=YINT(1)*XMAT(1,1)+YINT(2)*XMAT(1,2)+YINT(3)*XMAT(1,3)
  184. XINT(2)=YINT(1)*XMAT(2,1)+YINT(2)*XMAT(2,2)+YINT(3)*XMAT(2,3)
  185. XINT(3)=YINT(1)*XMAT(3,1)+YINT(2)*XMAT(3,2)+YINT(3)*XMAT(3,3)
  186. XINT(1)=XINT(1)+XBAR(1)
  187. XINT(2)=XINT(2)+XBAR(2)
  188. XINT(3)=XINT(3)+XBAR(3)
  189. IF (ABS(XINT(1)-XCOOR(1+IREF)).GE.RPREC.OR.
  190. # ABS(XINT(2)-XCOOR(2+IREF)).GE.RPREC.OR.
  191. # ABS(XINT(3)-XCOOR(3+IREF)).GE.RPREC) THEN
  192. XCOOR(1+IREF)=XINT(1)
  193. XCOOR(2+IREF)=XINT(2)
  194. XCOOR(3+IREF)=XINT(3)
  195. IBOUJ(IP)=1
  196. ENDIF
  197. END
  198.  
  199.  
  200.  

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