C AFFINI    SOURCE    SP204843  25/03/14    21:15:02     12201          

C  Ce sous-programme prepare l'affinite d'un objet
C  10/2003 : cas IDIM=1, operateur indisponible

      SUBROUTINE AFFINI

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)


-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
-INC SMELEME
-INC CCGEOME
-INC CCTOURN

C  Segment NON utilise :       SEGMENT ICPR(nbpts)

      IF (IDIM.EQ.1) THEN
        INTERR(1)=IDIM
        CALL ERREUR(709)
        RETURN
      ENDIF

      ICLE=4
C  Lecture du rapport de l'affinite
      CALL MESLIR(-130)
      CALL LIRREE(XXX,1,IRETOU)
      ANGLE=XXX
      IF (ANGLE.EQ.0.) CALL ERREUR(21)
      IF (IERR.NE.0) RETURN
C  Lecture d'un maillage, sinon lecture d'un point
      ICAS=1
      CALL MESLIR(-131)
      CALL LIROBJ('MAILLAGE',IOBJ,0,IRETOU)
      IF (IRETOU.NE.1) THEN
        ICAS=0
        CALL MESLIR(-131)
        CALL LIROBJ('POINT   ',IOBJ,1,IRETOU)
      ENDIF
C  Lecture des points definissant l'axe de l'affinite
      CALL MESLIR(-132)
      CALL LIROBJ('POINT   ',IPT1,1,IRETOU)
      CALL MESLIR(-133)
      CALL LIROBJ('POINT   ',IPT2,1,IRETOU)
      IF (IERR.NE.0) RETURN

      idimp1=IDIM+1
      SEGACT MCOORD*mod
      IREF=(IPT1-1)*idimp1
      XPT1=XCOOR(IREF+1)
      YPT1=XCOOR(IREF+2)
      ZPT1=0.
      IF (IDIM.GE.3) ZPT1=XCOOR(IREF+3)
      IREF=(IPT2-1)*idimp1
      XPT2=XCOOR(IREF+1)
      YPT2=XCOOR(IREF+2)
      ZPT2=0.
      IF (IDIM.GE.3) ZPT2=XCOOR(IREF+3)
      XVEC=XPT2-XPT1
      YVEC=YPT2-YPT1
      ZVEC=ZPT2-ZPT1
      DVEC=SQRT(XVEC*XVEC+YVEC*YVEC+ZVEC*ZVEC)
      IF (DVEC.EQ.0.) CALL ERREUR(21)
      IF (IERR.NE.0) RETURN
      XVEC=XVEC/DVEC
      YVEC=YVEC/DVEC
      ZVEC=ZVEC/DVEC
      XV1=-YVEC
      YV1=XVEC
      DV1=XV1*XV1+YV1*YV1
      IF (DV1.GE.0.1) THEN
        ZV1=0.
        DV1=SQRT(DV1)
        XV1=XV1/DV1
        YV1=YV1/DV1
      ELSE
        XV1=0.
        YV1=-ZVEC
        ZV1=YVEC
        DV1=SQRT(YV1*YV1+ZV1*ZV1)
        YV1=YV1/DV1
        ZV1=ZV1/DV1
      ENDIF
      XV2=YVEC*ZV1-ZVEC*YV1
      YV2=ZVEC*XV1-XVEC*ZV1
      ZV2=XVEC*YV1-YVEC*XV1

      IF (ICAS.EQ.1) THEN
        CALL INTOPE(IOBJ)
        RETURN
      ENDIF

      IREF=(IOBJ-1)*idimp1
      XD=XCOOR(IREF+1)-XPT1
      YD=XCOOR(IREF+2)-YPT1
      ZD=0.
      IF (IDIM.GE.3) ZD=XCOOR(IREF+3)-ZPT1
      XE=XD*XV1+YD*YV1+ZD*ZV1
      YE=XD*XV2+YD*YV2+ZD*ZV2
      ZE=XD*XVEC+YD*YVEC+ZD*ZVEC
      XD=XE
      YD=YE
      ZD=ZE*ANGLE
      SEGADJ MCOORD
      IPoin=(NBPTS-1)*idimp1
      XCOOR(IPoin+1)=XD*XV1+YD*XV2+ZD*XVEC+XPT1
      XCOOR(IPoin+2)=XD*YV1+YD*YV2+ZD*YVEC+YPT1
      IF (IDIM.GE.3) XCOOR(IPoin+3)=XD*ZV1+YD*ZV2+ZD*ZVEC+ZPT1
      XCOOR(IPoin+idimp1)=XCOOR(IREF+idimp1)
      CALL ECROBJ('POINT   ',NBPTS)

      RETURN
      END