Télécharger promod.eso

Retour à la liste

Numérotation des lignes :

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

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