Esope source files

   1 : C PVECT     SOURCE    GOUNAND   11/10/07    21:16:13     7150           
   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
  14 :          CALL ERREUR(709)
  15 :          RETURN
  16 :       ENDIF
  17 : C
  17 :       CALL LIROBJ('POINT ',IP1,0,IRETOU)
  18 :       IF(IRETOU.EQ.0) GO TO 30
  19 : C
  20 : C     CAS DES VECTEURS
  21 : C
  22 :       SEGACT MCOORD
  23 :       IREF1=(IDIM+1)*(IP1-1)
  24 :       X1=XCOOR(IREF1+1)
  25 :       Y1=XCOOR(IREF1+2)
  26 :       IF (IDIM.EQ.3) GOTO 10
  27 :       NBPTS=XCOOR(/1)/3+1
  28 :       SEGADJ MCOORD
  29 :       XCOOR((NBPTS-1)*3+1)=-Y1
  30 :       XCOOR((NBPTS-1)*3+2)=X1
  31 :       XCOOR((NBPTS-1)*3+3)=DENSIT
  32 :       GOTO 20
  32 :   10  CALL LIROBJ('POINT ',IP2,1,IRETOU)
  33 :       IF (IERR.NE.0) RETURN
  34 :       IREF2=(IDIM+1)*(IP2-1)
  35 :       Z1=XCOOR(IREF1+3)
  36 :       X2=XCOOR(IREF2+1)
  37 :       Y2=XCOOR(IREF2+2)
  38 :       Z2=XCOOR(IREF2+3)
  39 :       NBPTS=XCOOR(/1)/4+1
  40 :       SEGADJ MCOORD
  41 :       XCOOR((NBPTS-1)*4+1)=Y1*Z2-Z1*Y2
  42 :       XCOOR((NBPTS-1)*4+2)=Z1*X2-X1*Z2
  43 :       XCOOR((NBPTS-1)*4+3)=X1*Y2-Y1*X2
  44 :       XCOOR((NBPTS-1)*4+4)=DENSIT
  45 :   20  CONTINUE
  46 :       IR=NBPTS
  46 :       CALL ECROBJ('POINT ',IR)
  47 :       RETURN
  48 : C
  49 : C     CAS DES CHPOINTS
  50 : C
  51 :  30   CONTINUE
  51 :       CALL LIROBJ('CHPOINT ',MCHPO1,1,IRETOU)
  52 :       IF (IERR.NE.0) RETURN
  52 :       CALL LIROBJ('LISTMOTS',MLMOT1,1,IRETOU)
  53 :       IF (IERR.NE.0) RETURN
  54 :       IF (IDIM.EQ.3) THEN
  54 :          CALL LIROBJ('CHPOINT ',MCHPO2,1,IRETOU)
  55 :          IF (IERR.NE.0) RETURN
  55 :          CALL LIROBJ('LISTMOTS',MLMOT2,1,IRETOU)
  56 :          IF (IERR.NE.0) RETURN
  57 :       ENDIF
  57 :       CALL LIROBJ('LISTMOTS',MLMOT3,1,IRETOU)
  58 :       IF (IERR.NE.0) RETURN
  58 :       CALL PROVCC(MCHPO1,MCHPO2,MLMOT1,MLMOT2,MLMOT3,MCHPO3)
  59 :       IF (IERR.NE.0) RETURN
  59 :       CALL ECROBJ('CHPOINT ',MCHPO3)
  60 :       RETURN
  61 :       END
  62 : 
  63 : 
  64 : 
  65 : 
  66 : 
  67 : 
  68 : 
  69 : 
  70 : 
  71 : 
  72 :