C PROMOD    SOURCE    PV        20/03/24    21:20:28     10554          
C  PROJECTION SPECIALE POUR MODI
      SUBROUTINE PROMOD(ICPR,XPROJ,IOEIL,ICLE,IBOUJ)
      IMPLICIT INTEGER(I-N)
-INC SMCOORD

-INC PPARAM
-INC CCOPTIO
      SEGMENT ICPR(0)
      SEGMENT IBOUJ(ITE)
      SEGMENT XPROJ(3,0)
      DIMENSION XBAR(3),OEIL(3),XMAT(3,3),XINT(3),YINT(3)
      SAVE XBAR,XMAT,RPREC
      ITE=ICPR(/1)
      SEGADJ IBOUJ
      IF (ICLE.NE.1) GOTO 100
      IF (IDIM.EQ.2) THEN
       DO 10 I=1,ICPR(/1)
       IP=ICPR(I)
       IF (IP.EQ.0) GOTO 10
       IREF=(IDIM+1)*(I-1)
       DO 20 J=1,2
       XPROJ(J,IP)=XCOOR(IREF+J)
  20   CONTINUE
       XPROJ(J,IP)=0.
  10   CONTINUE
       RETURN
      ENDIF
*  CALCUL DE LA MATRICE DE PROJECTION
*  RECHERCHE DU BARYCENTRE GENERAL
      RPREC=0.
      XBAR(1)=0.
      XBAR(2)=0.
      XBAR(3)=0.
      NP=0
      DO 30 I=1,ICPR(/1)
      IP=ICPR(I)
      IF (IP.EQ.0) GOTO 30
      NP=NP+1
      IREF=(IDIM+1)*(I-1)
      DO 50 J=1,3
      XXX=XCOOR(IREF+J)
      RPREC=MAX(RPREC,ABS(XXX))
      XBAR(J)=XXX+XBAR(J)
  50  CONTINUE
  30  CONTINUE
      RPREC=RPREC*1E-5
      XBAR(1)=XBAR(1)/NP
      XBAR(2)=XBAR(2)/NP
      XBAR(3)=XBAR(3)/NP
* OEIL
      IREF=(IDIM+1)*(IOEIL-1)
      OEIL(1)=XCOOR(IREF+1)
      OEIL(2)=XCOOR(IREF+2)
      OEIL(3)=XCOOR(IREF+3)
      XMAT(1,3)=OEIL(1)-XBAR(1)
      XMAT(2,3)=OEIL(2)-XBAR(2)
      XMAT(3,3)=OEIL(3)-XBAR(3)
      SMAT=SQRT(XMAT(1,3)**2+XMAT(2,3)**2+XMAT(3,3)**2)
      IF (SMAT.EQ.0.) CALL ERREUR(21)
      IF (IERR.NE.0) RETURN
      XMAT(1,3)=XMAT(1,3)/SMAT
      XMAT(2,3)=XMAT(2,3)/SMAT
      XMAT(3,3)=XMAT(3,3)/SMAT
      SEGAct MCOORD*mod
      NBPTS=nbpts+1
      SEGADJ MCOORD
      XCOOR((NBPTS-1)*4+1)=XMAT(1,3)
      XCOOR((NBPTS-1)*4+2)=XMAT(2,3)
      XCOOR((NBPTS-1)*4+3)=XMAT(3,3)
      XCOOR((NBPTS-1)*4+4)=1.
      ICPR(**)=0
* AXE DES Z DONNE AXE DES Y
      ZCOMP=XMAT(3,3)
      XMAT(1,2)= (0.-XMAT(1,3)*ZCOMP)
      XMAT(2,2)= (0.-XMAT(2,3)*ZCOMP)
      XMAT(3,2)= (1.-XMAT(3,3)*ZCOMP)
      SMAT=SQRT(XMAT(1,2)**2+XMAT(2,2)**2+XMAT(3,2)**2)
* SI PAS POSSIBLE PRENDRE AXE Y
      IF (SMAT.LE.0.1) THEN
       YCOMP=XMAT(2,3)
       XMAT(1,2)= (0.-XMAT(1,3)*YCOMP)
       XMAT(2,2)= (1.-XMAT(2,3)*YCOMP)
       XMAT(3,2)= (0.-XMAT(3,3)*YCOMP)
       SMAT=SQRT(XMAT(1,2)**2+XMAT(2,2)**2+XMAT(3,2)**2)
      ENDIF
      XMAT(1,2)=XMAT(1,2)/SMAT
      XMAT(2,2)=XMAT(2,2)/SMAT
      XMAT(3,2)=XMAT(3,2)/SMAT
*  TROISIEME VECTEUR
      XMAT(1,1)= (XMAT(2,2)*XMAT(3,3)-XMAT(3,2)*XMAT(2,3))
      XMAT(2,1)= (XMAT(3,2)*XMAT(1,3)-XMAT(1,2)*XMAT(3,3))
      XMAT(3,1)= (XMAT(1,2)*XMAT(2,3)-XMAT(2,2)*XMAT(1,3))
*  PROJECTION
       DO 40 I=1,ICPR(/1)
       IP=ICPR(I)
       IF (IP.EQ.0) GOTO 40
       IREF=(IDIM+1)*(I-1)
       XINT(1)=XCOOR(IREF+1)-XBAR(1)
       XINT(2)=XCOOR(IREF+2)-XBAR(2)
       XINT(3)=XCOOR(IREF+3)-XBAR(3)
       XPROJ(1,IP)=XINT(1)*XMAT(1,1)+XINT(2)*XMAT(2,1)+XINT(3)*XMAT(3,1)
       XPROJ(2,IP)=XINT(1)*XMAT(1,2)+XINT(2)*XMAT(2,2)+XINT(3)*XMAT(3,2)
       XPROJ(3,IP)=XINT(1)*XMAT(1,3)+XINT(2)*XMAT(2,3)+XINT(3)*XMAT(3,3)
       XPROJ(3,IP)=-XPROJ(3,IP)
  40   CONTINUE
       RETURN
 100  CONTINUE
      IF (ICLE.NE.2) GOTO 200
      IF (IDIM.EQ.2) THEN
       DO 110 I=1,ICPR(/1)
       IP=ICPR(I)
       IF (IP.EQ.0) GOTO 110
       IREF=(IDIM+1)*(I-1)
       DO 120 J=1,2
       XCOOR(IREF+J)=XPROJ(J,IP)
 120   CONTINUE
 110   CONTINUE
       RETURN
      ENDIF
*  DEPROJECTION
       DO 140 I=1,ICPR(/1)
       IP=ICPR(I)
       IF (IP.EQ.0) GOTO 140
       IREF=(IDIM+1)*(I-1)
       YINT(1)=XPROJ(1,IP)
       YINT(2)=XPROJ(2,IP)
       YINT(3)=-XPROJ(3,IP)
       XINT(1)=YINT(1)*XMAT(1,1)+YINT(2)*XMAT(1,2)+YINT(3)*XMAT(1,3)
       XINT(2)=YINT(1)*XMAT(2,1)+YINT(2)*XMAT(2,2)+YINT(3)*XMAT(2,3)
       XINT(3)=YINT(1)*XMAT(3,1)+YINT(2)*XMAT(3,2)+YINT(3)*XMAT(3,3)
       XINT(1)=XINT(1)+XBAR(1)
       XINT(2)=XINT(2)+XBAR(2)
       XINT(3)=XINT(3)+XBAR(3)
       IF (ABS(XINT(1)-XCOOR(1+IREF)).GE.RPREC.OR.
     #     ABS(XINT(2)-XCOOR(2+IREF)).GE.RPREC.OR.
     #     ABS(XINT(3)-XCOOR(3+IREF)).GE.RPREC) THEN
        XCOOR(1+IREF)=XINT(1)
        XCOOR(2+IREF)=XINT(2)
        XCOOR(3+IREF)=XINT(3)
        IBOUJ(IP)=1
       ENDIF
 140   CONTINUE
       RETURN
 200  CONTINUE
      IF (ICLE.NE.3) GOTO 300
      IF (IDIM.EQ.2) THEN
       IPP=ICPR(IOEIL)
       IREF=(IDIM+1)*(IOEIL-1)
       DO 210 J=1,2
       XPROJ(J,IPP)=XCOOR(IREF+J)
 210   CONTINUE
       RETURN
      ENDIF
*  REPROJECTION DU POINT IOEIL (NON CE N'EST PAS LE MEME)
       IP=ICPR(IOEIL)
       IF (IP.EQ.0) RETURN
       IREF=(IDIM+1)*(IOEIL-1)
       XINT(1)=XCOOR(IREF+1)-XBAR(1)
       XINT(2)=XCOOR(IREF+2)-XBAR(2)
       XINT(3)=XCOOR(IREF+3)-XBAR(3)
       XPROJ(1,IP)=XINT(1)*XMAT(1,1)+XINT(2)*XMAT(2,1)+XINT(3)*XMAT(3,1)
       XPROJ(2,IP)=XINT(1)*XMAT(1,2)+XINT(2)*XMAT(2,2)+XINT(3)*XMAT(3,2)
       XPROJ(3,IP)=XINT(1)*XMAT(1,3)+XINT(2)*XMAT(2,3)+XINT(3)*XMAT(3,3)
       XPROJ(3,IP)=-XPROJ(3,IP)
       RETURN
 300  CONTINUE
      IF (IDIM.EQ.2) THEN
       IPP=ICPR(IOEIL)
       IREF=(IDIM+1)*(IOEIL-1)
       DO 310 J=1,2
       XCOOR(IREF+J)=XPROJ(J,IPP)
 310   CONTINUE
       RETURN
      ENDIF
*  DEPROJECTION DU POINT IOEIL (NON CE N'EST PAS LE MEME)
       IP=ICPR(IOEIL)
       IF (IP.EQ.0) RETURN
       IREF=(IDIM+1)*(IOEIL-1)
       YINT(1)=XPROJ(1,IP)
       YINT(2)=XPROJ(2,IP)
       YINT(3)=-XPROJ(3,IP)
       XINT(1)=YINT(1)*XMAT(1,1)+YINT(2)*XMAT(1,2)+YINT(3)*XMAT(1,3)
       XINT(2)=YINT(1)*XMAT(2,1)+YINT(2)*XMAT(2,2)+YINT(3)*XMAT(2,3)
       XINT(3)=YINT(1)*XMAT(3,1)+YINT(2)*XMAT(3,2)+YINT(3)*XMAT(3,3)
       XINT(1)=XINT(1)+XBAR(1)
       XINT(2)=XINT(2)+XBAR(2)
       XINT(3)=XINT(3)+XBAR(3)
       IF (ABS(XINT(1)-XCOOR(1+IREF)).GE.RPREC.OR.
     #     ABS(XINT(2)-XCOOR(2+IREF)).GE.RPREC.OR.
     #     ABS(XINT(3)-XCOOR(3+IREF)).GE.RPREC) THEN
        XCOOR(1+IREF)=XINT(1)
        XCOOR(2+IREF)=XINT(2)
        XCOOR(3+IREF)=XINT(3)
        IBOUJ(IP)=1
       ENDIF
       END