C PCYLI     SOURCE    PV090527  23/10/25    21:15:05     11773          
C    CE SOUS-PROGRAMME RAMENNE UN CYLINDRE SUR SES COORDONNEES PROPRES
C
      SUBROUTINE PCYLI(IOP,FER,XPROJ,NDEB,NUMNP,IP1,IP2,tcval,isens)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
-INC SMCOORD

-INC PPARAM
-INC CCOPTIO
      real*8 tcval(*)
      SEGMENT/FER/(NFI(ITT),MAI(IPP),ITOUR)
      SEGMENT XPROJ(3,IMAX)
*      tcval  1   2     3     4    5    6
*      SAVE XORIG,YORIG,ZORIG,XAXE,YAXE,ZAXE
* tcval     7  8  9
*      SAVE XP1,YP1,ZP1
* tcval           10
*      SAVE ISENS,RAYON
      IF (IOP.EQ.2) GOTO 100
      IMCT=MAI(ITOUR+1)
      INCT=MAI(1)+1
      IMAX=(IMCT**2)+10
      CALL LIRENT(IMAX,0,IRETOU)
      IF (IRETOU.NE.0) IMAX=MAX(1,IMAX)
      NDEB=IMCT+1
      SEGINI XPROJ
      SEGACT MCOORD
C   AXE DU CYLINDRE
      IREF=IP1*4-3
      XP1=XCOOR(IREF)
      YP1=XCOOR(IREF+1)
      ZP1=XCOOR(IREF+2)
      tcval(7)=xp1
      tcval(8)=yp1
      tcval(9)=zp1
      IREF=IP2*4-3
      XP2=XCOOR(IREF)
      YP2=XCOOR(IREF+1)
      ZP2=XCOOR(IREF+2)
      XAXE=XP2-XP1
      YAXE=YP2-YP1
      ZAXE=ZP2-ZP1
      DAXE=SQRT(XAXE**2+YAXE**2+ZAXE**2)
      IF (DAXE.EQ.0.) CALL ERREUR(21)
      IF (IERR.NE.0.) RETURN
      XAXE=XAXE/DAXE
      YAXE=YAXE/DAXE
      ZAXE=ZAXE/DAXE
      tcval(4)=xaxe
      tcval(5)=yaxe
      tcval(6)=zaxe
C  DEROULONS LE CYLINDRE
      IREF=4*NFI(IMCT)-3
      XV1=XCOOR(IREF)-XP1
      YV1=XCOOR(IREF+1)-YP1
      ZV1=XCOOR(IREF+2)-ZP1
      XI=XV1*XAXE+YV1*YAXE+ZV1*ZAXE
      XV1=XV1-XI*XAXE
      YV1=YV1-XI*YAXE
      ZV1=ZV1-XI*ZAXE
      IF (XV1**2+YV1**2+ZV1**2.EQ.0.) CALL ERREUR(21)
      IF (IERR.NE.0) RETURN
      XORIG=XV1
      YORIG=YV1
      ZORIG=ZV1
      tcval(1)=xorig
      tcval(2)=yorig
      tcval(3)=zorig
      RAYON=0
      COT=0
      DO 1 I=INCT,max(IMCT,mai(itour+2))
      II=NFI(I)
      IREF=4*II-3
      XV2=XCOOR(IREF)-XP1
      YV2=XCOOR(IREF+1)-YP1
      ZV2=XCOOR(IREF+2)-ZP1
      XPROJ(1,I)=XV2*XAXE+YV2*YAXE+ZV2*ZAXE
      XPROJ(3,I)=XCOOR(IREF+3)
      XI=XPROJ(1,I)
      XV2=XV2-XI*XAXE
      YV2=YV2-XI*YAXE
      ZV2=ZV2-XI*ZAXE
      R=XV2**2+YV2**2+ZV2**2
      IF (R.EQ.0..and.i.le.imct) CALL ERREUR(21)
      IF (IERR.NE.0) RETURN
      if (i.le.imct) RAYON=RAYON+R
      ANG=ATAN2(XAXE*(YV1*ZV2-YV2*ZV1)+YAXE*(ZV1*XV2-ZV2*XV1)+
     #  ZAXE*(XV1*YV2-XV2*YV1),XV1*XV2+YV1*YV2+ZV1*ZV2)
      COT=COT+ANG
      XPROJ(2,I)=COT
      XV1=XV2
      YV1=YV2
      ZV1=ZV2
   1  CONTINUE
      RAYON2=RAYON/(IMCT-INCT+1)
      RAYON=SQRT(RAYON2)
      tcval(10)=rayon
      DO 2 I=INCT,max(IMCT,mai(itour+2))
      XPROJ(2,I)=XPROJ(2,I)*RAYON
      II=NFI(I)
      NFI(I)=I
      IREF=4*II-3
      XV=XCOOR(IREF)-XP1
      YV=XCOOR(IREF+1)-YP1
      ZV=XCOOR(IREF+2)-ZP1
      SCAL=XV*XAXE+YV*YAXE+ZV*ZAXE
      XV=XV-SCAL*XAXE
      YV=YV-SCAL*YAXE
      ZV=ZV-SCAL*ZAXE
      RAY2=XV**2+YV**2+ZV**2
      RAP=RAY2/RAYON2
      IF ((RAP.GT.1.02.OR.RAP.LT.0.98).and.i.le.imct) CALL ERREUR(1142)
   2  CONTINUE
C  IL FAUT TOURNER DANS LE BON SENS
      SURF=0
      DO   IT=1,ITOUR
      II1=MAI(IT-1+1)+1
      II2=MAI(IT+1)
      XV1=XPROJ(1,II2)
      YV1=XPROJ(2,II2)
      DO   I=II1,II2
       XV2=XPROJ(1,I)
       YV2=XPROJ(2,I)
       IF (XPROJ(3,I).EQ.0.) XPROJ(3,I)=SQRT((XV2-XV1)**2+(YV2-YV1)**2)
       SURF=SURF+XV1*YV2-XV2*YV1
       XV1=XV2
       YV1=YV2
      enddo    
      enddo    
      ISENS=1
      IF (SURF.GT.0.) GOTO 5
      ISENS=-1
      DO 4 I=INCT,max(IMCT,mai(itour+2))
      XPROJ(1,I)=-XPROJ(1,I)
   4  CONTINUE
   5  CONTINUE
      RETURN
C   TRANSFORMATION INVERSE
 100  CONTINUE
      SEGACT MCOORD*mod
      xorig=tcval(1)
      yorig=tcval(2)
      zorig=tcval(3)
      xaxe=tcval(4)
      yaxe=tcval(5)
      zaxe=tcval(6)
      xp1=tcval(7)
      yp1=tcval(8)
      zp1=tcval(9)
      rayon=tcval(10)
      XREP1=XORIG
      YREP1=YORIG
      ZREP1=ZORIG
      XREP2=YAXE*ZREP1-ZAXE*YREP1
      YREP2=ZAXE*XREP1-XAXE*ZREP1
      ZREP2=XAXE*YREP1-YAXE*XREP1
      IF (NUMNP.LT.NDEB) GOTO 102
      NBPTA=nbpts
      NBPTS=NBPTA+NUMNP-NDEB+1
      SEGADJ MCOORD
      DO 101 I=NDEB,NUMNP
      Z=XPROJ(1,I)*ISENS
      ANG=XPROJ(2,I)/RAYON
      SI=SIN(ANG)
      CO=COS(ANG)
      XCOOR(NBPTA*4+1)=XREP1*CO+XREP2*SI+Z*XAXE+XP1
      XCOOR(NBPTA*4+2)=YREP1*CO+YREP2*SI+Z*YAXE+YP1
      XCOOR(NBPTA*4+3)=ZREP1*CO+ZREP2*SI+Z*ZAXE+ZP1
      XCOOR(NBPTA*4+4)=XPROJ(3,I)
      NBPTA=NBPTA+1
 101  CONTINUE
 102  CONTINUE
      SEGSUP XPROJ
      RETURN
      END