C DEDU2     SOURCE    SP204843  25/03/14    21:15:03     12201          
C DEDU2
C
C VERIFIE QUE LES POINTS DE LA GEOMETRIE ELEMENTAIRE IPT7
C SONT BIEN POINTES DANS ICP1
C APPELE PAR PROPER, POUR EXECUTION OPTIONS 'TRANS' ET 'ROTA' DE DEDU
C
C VERIFIE POUR DEDU ROTA QUE LES POINTS IMAGES SUPPOSES CORRESPONDENT
C EGALEMENT A LA ROTATION DES POINTS ANTECEDENTS POUR L ANGLE ET L AXE
C SPECIFIES
C  97/11 : KICH
       SUBROUTINE DEDU2(IPT7,ICP1,IRETOU,ITYP)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)

-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
-INC SMELEME
-INC CCGEOME
-INC CCTOURN
      SEGMENT ICP1(nbpts)

        IF (ITYP.EQ.5) SEGACT MCOORD
        IRETOU=0
        SEGINI,IPT3=IPT7
        IF (IPT3.LISOUS(/1).NE.0) THEN
          IRETOU = 10
* on ne verifie que les geometries elementaires (dedu2)
          CALL ERREUR(879)
          GOTO 200
        ENDIF
        CALL CHANGE(IPT3,1)
        SEGACT ICP1
        N = IPT3.NUM(/2)
        DO IJN=1,N
*      write(6,*)'noeud',IPT3.NUM(1,IJN),'pointe',ICP1(IPT3.NUM(1,IJN))
          IF (ICP1(IPT3.NUM(1,IJN)).EQ.0) THEN
            IRETOU=20
            GOTO 100
          ENDIF
c verification pour ROTA
          IF (ITYP.EQ.5) THEN
c image par la rotation
      IREF=IPT3.NUM(1,IJN)*(IDIM+1)
      IREF=IREF-IDIM
      XD=XCOOR(IREF)-XPT1
      YD=XCOOR(IREF+1)-YPT1
      ZD=XCOOR(IREF+2)-ZPT1
      IF (IDIM.EQ.2) ZD=0.
      XDENS=XCOOR(IREF+IDIM)
      CO=COS(ANGLE)
      SI=SIN(ANGLE)
      XE=XD*XV1+YD*YV1+ZD*ZV1
      YE=XD*XV2+YD*YV2+ZD*ZV2
      ZE=XD*XVEC+YD*YVEC+ZD*ZVEC
      XD=XE*CO-YE*SI
      YD=XE*SI+YE*CO
      ZD=ZE
      XIMA=XD*XV1+YD*XV2+ZD*XVEC+XPT1
      YIMA=XD*YV1+YD*YV2+ZD*YVEC+YPT1
      IF (IDIM.NE.2) ZIMA=XD*ZV1+YD*ZV2+ZD*ZVEC+ZPT1
c image pointee
      IREF=ICP1(IPT3.NUM(1,IJN))*(IDIM+1)
      IREF=IREF-IDIM
      XPOIN=XCOOR(IREF)
      YPOIN=XCOOR(IREF+1)
      ZPOIN=XCOOR(IREF+2)
            DELTX = ABS(XIMA - XPOIN)
            DELTY = ABS(YIMA - YPOIN)
            IF (IDIM.EQ.3) DELTZ = ABS(ZIMA - ZPOIN)
            IF (IDIM.LT.3) THEN
              IF ((DELTX.LE.(1.E-4*ABS(XPOIN)))
     2.AND.(DELTY.LE.(1.E-4*ABS(YPOIN)))) THEN
                CONTINUE
              ELSE
                CALL ERREUR(885)
                RETURN
              ENDIF
            ELSE IF (IDIM.EQ.3) THEN
              IF ((DELTX.LE.(1.E-4*ABS(XPOIN)))
     2.AND.(DELTY.LE.(1.E-4*ABS(YPOIN)))
     3.AND.(DELTZ.LE.(1.E-4*ABS(ZPOIN)))) THEN
                CONTINUE
              ELSE
                CALL ERREUR(885)
                RETURN
              ENDIF
            ENDIF
          ENDIF
        ENDDO
  100  CONTINUE
       SEGDES ICP1

  200  CONTINUE
       RETURN
       END




 
 
 
