C ROND      SOURCE    CB215821  23/01/25    21:15:33     11573          
C     1234567890124567890124567898012456789012345678901234567890123456

C     SOURCE : L. DI VALENTIN    LE 17/06/97

C     Cette subroutine appele par l'operateur LIGN (grace au mot cle
C     ROTA) prepare les donnees a transmettre a la subroutine ARC
C     pour construire un arc de cercle dont on connait le centre
C     (CENTRE), un point (POINT1) et l'angle d'ouverture en degre a
C     partir de ce point.

C     En dimension 3, il est necessaire de fournir la normale au
C     cercle, ce qui fournit a la fois le plan contenant le cercle
C     et le sens trigonometrique positif dans ce plan.


      SUBROUTINE ROND


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

-INC PPARAM
-INC CCOPTIO
-INC SMELEME
-INC SMCOORD


      INTEGER INBR,IRET,POINT1,POINT2,NORMAL,CENTRE
      REAL*8  ANGLE,DENS1,DENS2,NORME
      CHARACTER*(4) TYPE*8
      CHARACTER*4 MOTCLE(2)
      logical ltelq


      DATA MOTCLE/'DINI','DFIN'/


      INBR = 0
      CALL LIRENT(INBR,0,IRET)


*     IF (DENS1*DENS2.LE.0.D0.AND.INBR.LE.0) THEN
*        CALL ERREUR(17)
*        RETURN
*     ENDIF


C     Lecture du centre.

      CALL LIROBJ('POINT',CENTRE,1,IRET)
      IF (IRET.EQ.0) RETURN


C     Si on a un maillage, on extrait le dernier point
      IPT1=0
      CALL LIROBJ('MAILLAGE',IPT1,0,IRET)
      IF (IRET.EQ.1) THEN
         CALL ACTOBJ('MAILLAGE',IPT1,1)
         CALL EXTRPO(IPT1,1,POINT1)
         IF(IERR .NE. 0)RETURN
      ELSE
         CALL LIROBJ('POINT',POINT1,1,IRET)
      ENDIF
      IF (IERR.NE.0) RETURN

C     Lecture de l'angle de rotation.

      CALL LIRREE(ANGLE,1,IRET)
      IF (IRET.EQ.0) RETURN

      ANGLE = ANGLE * XPI / 180.D0


C     En dimension 3, lecture du point fournissant le sens
C     trigonométrique

      IF (IDIM.EQ.3) THEN
         CALL LIROBJ('POINT',NORMAL,1,IRET)
         IF (IRET.EQ.0) RETURN
      ENDIF


C     On recupere les coordonnees du CENTRE
      SEGACT,MCOORD

      XCEN = XCOOR((CENTRE-1)*(IDIM+1) + 1)
      YCEN = XCOOR((CENTRE-1)*(IDIM+1) + 2)
      IF (IDIM.EQ.3) THEN
         ZCEN = XCOOR((CENTRE-1)*(IDIM+1) + 3)
      ENDIF
      DENS2=XCOOR((CENTRE)*(IDIM+1))

C     On recupere les coordonnees du vecteur (CENTRE -> POINT1)

      X1 = XCOOR((POINT1-1)*(IDIM+1) + 1) - XCEN
      Y1 = XCOOR((POINT1-1)*(IDIM+1) + 2) - YCEN

      IF (IDIM.EQ.3) THEN
         Z1 = XCOOR((POINT1-1)*(IDIM+1) + 3) - ZCEN
      ELSE
         Z1 = 0.D0
      ENDIF
      DENS1=XCOOR((POINT1)*(IDIM+1))

C     On cree une place memoire pour le deuxieme point extremite

      SEGACT,MCOORD*MOD
      NBPTS  = nbpts+1
      POINT2 = NBPTS
      SEGADJ,MCOORD


C     Calcul des coordonnees de ce point :


C     Si IDIM = 3 on recupere le vecteur normal.

      IF (IDIM.EQ.3) THEN

         Xn = XCOOR((NORMAL-1)*(IDIM+1) + 1)
         Yn = XCOOR((NORMAL-1)*(IDIM+1) + 2)
         Zn = XCOOR((NORMAL-1)*(IDIM+1) + 3)

         NORME = SQRT(Xn*Xn + Yn*Yn + Zn*Zn)

         Xn = Xn/NORME
         Yn = Yn/NORME
         Zn = Zn/NORME

      ELSE

         Xn = 0.D0
         Yn = 0.D0
         Zn = 1.D0

      ENDIF


C     POINT3 = NORMAL vectoriel POINT1 :

      X3 = Yn*Z1 - Zn*Y1
      Y3 = Zn*X1 - Xn*Z1
      Z3 = Xn*Y1 - Yn*X1


C     Calcul des coordonnees de POINT2 (point extremite)

      XCOOR((POINT2-1)*(IDIM+1) + 1) = XCEN + COS(ANGLE)*X1
     &     + SIN(ANGLE)*X3
      XCOOR((POINT2-1)*(IDIM+1) + 2) = YCEN + COS(ANGLE)*Y1
     &     + SIN(ANGLE)*Y3
      IF (IDIM.EQ.3) THEN
         XCOOR((POINT2-1)*(IDIM+1) + 3) = ZCEN + COS(ANGLE)*Z1
     &        + SIN(ANGLE)*Z3
      ENDIF
      DENS2=SQRT(ABS(DENS1*DENS2))
         XCOOR(POINT2*(IDIM+1))=DENS2


 413  CALL LIRMOT(MOTCLE,2,IRET,0)

      IF (IRET.EQ.1) THEN
         CALL LIRREE(DENS1,1,IRET)
         IF (IRET.EQ.0) RETURN
         GOTO 413

      ELSEIF (IRET.EQ.2) THEN
         CALL MESLIR(-169)
         CALL LIRREE(DENS2,1,IRET)
         IF (IRET.EQ.0) RETURN
         GOTO 413

      ENDIF


      CALL ARC(POINT1,CENTRE,NORMAL,ANGLE,INBR,DENS1,DENS2,POINT2)      
      SEGDES,MCOORD
      
      IF (IERR.NE.0) RETURN
      IF (IPT1.NE.0) THEN
        CALL LIROBJ('MAILLAGE',IPT2,1,IRETOU)
        IF (IERR.NE.0) RETURN
        CALL ACTOBJ('MAILLAGE',IPT2,1)
        ltelq=.false.
        CALL FUSE(IPT1,IPT2,IPT3,ltelq)
        IF (IERR.NE.0) RETURN
        SEGSUP IPT2
        CALL ACTOBJ('MAILLAGE',IPT3,1)
        CALL ECROBJ('MAILLAGE',IPT3)
      ENDIF
      RETURN

      END