Esope source files

   1 : C COUPEK    SOURCE    CHAT      05/01/12    22:24:44     5004           
   2 :       SUBROUTINE COUPEK(XYZ1,XYZ2,XYZ3,DIS1,DIS2,DIS3,
   3 :      >                  NUM0,MELEME,IELEM,JCOLOR)
   4 : C
   5 : C     Esclave de COUPE
   6 : C     Reorganization des noeuds de la face opposee au point
   7 : C     coupe par le plan de coupe: le premier point est celui
   8 : C     commun aux 2 cotes coupes
   9 : C
  10 :       IMPLICIT INTEGER(I-N)
  11 :       IMPLICIT REAL*8(A-H,O-Z)
  12 : -INC CCOPTIO
  13 : -INC SMCOORD
  14 : -INC SMELEME
  15 : C
  16 :       DIMENSION XYZ1(4),XYZ2(4),XYZ3(4)
  17 :       PARAMETER(UN=1.D0)
  18 : C
  19 :       DINDEX=SIGN(UN,DIS1)+SIGN(UN,DIS2)+SIGN(UN,DIS3)
  20 :       IF(SIGN(UN,DIS1).NE.DINDEX)THEN
  20 :         CALL COUPEL(XYZ1,XYZ2,XYZ3,DIS1,DIS2,DIS3,
  21 :      >              NUM0,MELEME,IELEM,JCOLOR)
  22 :       ELSE IF(SIGN(UN,DIS2).NE.DINDEX)THEN
  22 :         CALL COUPEL(XYZ2,XYZ3,XYZ1,DIS2,DIS3,DIS1,
  23 :      >              NUM0,MELEME,IELEM,JCOLOR)
  24 :       ELSE IF(SIGN(UN,DIS3).NE.DINDEX)THEN
  24 :         CALL COUPEL(XYZ3,XYZ1,XYZ2,DIS3,DIS1,DIS2,
  25 :      >              NUM0,MELEME,IELEM,JCOLOR)
  26 :       ELSE
  27 :       ENDIF        
  28 : C
  29 :       RETURN
  30 :       END
  31 :  
  32 :