Télécharger pvect.eso

Retour à la liste

Numérotation des lignes :

  1. C PVECT SOURCE BP208322 16/11/18 21:20:36 9177
  2. C CALCULE LE PRODUIT VECTORIEL DE (IDIM-1) VECTEURS
  3. C
  4. SUBROUTINE PVECT
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT real*8 (a-h,o-z)
  7. -INC CCOPTIO
  8. -INC CCGEOME
  9. -INC SMCOORD
  10. C
  11. IF (IDIM.NE.2.AND.IDIM.NE.3) THEN
  12. C 709 2
  13. C Fonction indisponible en dimension %i1.
  14. INTERR(1)=IDIM
  15. CALL ERREUR(709)
  16. RETURN
  17. ENDIF
  18. C
  19. CALL LIROBJ('POINT ',IP1,0,IRETOU)
  20. IF(IRETOU.EQ.0) GO TO 30
  21. C
  22. C CAS DES VECTEURS
  23. C
  24. SEGACT MCOORD
  25. IREF1=(IDIM+1)*(IP1-1)
  26. X1=XCOOR(IREF1+1)
  27. Y1=XCOOR(IREF1+2)
  28. IF (IDIM.EQ.3) GOTO 10
  29. NBPTS=XCOOR(/1)/3+1
  30. SEGADJ MCOORD
  31. XCOOR((NBPTS-1)*3+1)=-Y1
  32. XCOOR((NBPTS-1)*3+2)=X1
  33. XCOOR((NBPTS-1)*3+3)=DENSIT
  34. GOTO 20
  35. 10 CALL LIROBJ('POINT ',IP2,1,IRETOU)
  36. IF (IERR.NE.0) RETURN
  37. IREF2=(IDIM+1)*(IP2-1)
  38. Z1=XCOOR(IREF1+3)
  39. X2=XCOOR(IREF2+1)
  40. Y2=XCOOR(IREF2+2)
  41. Z2=XCOOR(IREF2+3)
  42. NBPTS=XCOOR(/1)/4+1
  43. SEGADJ MCOORD
  44. XCOOR((NBPTS-1)*4+1)=Y1*Z2-Z1*Y2
  45. XCOOR((NBPTS-1)*4+2)=Z1*X2-X1*Z2
  46. XCOOR((NBPTS-1)*4+3)=X1*Y2-Y1*X2
  47. XCOOR((NBPTS-1)*4+4)=DENSIT
  48. 20 CONTINUE
  49. IR=NBPTS
  50. CALL ECROBJ('POINT ',IR)
  51. RETURN
  52. C
  53. C CAS DES CHPOINTS
  54. C
  55. 30 CONTINUE
  56. CALL LIROBJ('CHPOINT ',MCHPO1,1,IRETOU)
  57. IF (IERR.NE.0) RETURN
  58. CALL LIROBJ('LISTMOTS',MLMOT1,1,IRETOU)
  59. IF (IERR.NE.0) RETURN
  60. IF (IDIM.EQ.3) THEN
  61. CALL LIROBJ('CHPOINT ',MCHPO2,1,IRETOU)
  62. IF (IERR.NE.0) RETURN
  63. CALL LIROBJ('LISTMOTS',MLMOT2,1,IRETOU)
  64. IF (IERR.NE.0) RETURN
  65. ENDIF
  66. CALL LIROBJ('LISTMOTS',MLMOT3,1,IRETOU)
  67. IF (IERR.NE.0) RETURN
  68. CALL PROVCC(MCHPO1,MCHPO2,MLMOT1,MLMOT2,MLMOT3,MCHPO3)
  69. IF (IERR.NE.0) RETURN
  70. CALL ECROBJ('CHPOINT ',MCHPO3)
  71. RETURN
  72. END
  73.  
  74.  
  75.  
  76.  
  77.  
  78.  
  79.  
  80.  
  81.  
  82.  
  83.  
  84.  
  85.  
  86.  

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