C MOCO      SOURCE    PV        05/09/22    21:19:46     5181
C  ECRITURE COORDONNES D'UN POINT
C
      SUBROUTINE MOCO(XPROJ,IVU,KON1,IDCP,ICPR,IBOUJ)
      IMPLICIT INTEGER(I-N)
      SEGMENT XPROJ(3,0)
      SEGMENT IVU(0)
      SEGMENT IDCP(0)
      SEGMENT ICPR(0)
      SEGMENT IBOUJ(0)
      SEGMENT /KON1/(KON(NBCON,NMAX)),KON2.KON1

-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
      COMMON /CMODI/LIGMAX,XPREC,YPREC
      DIMENSION XTR(2),YTR(2),ZTR(2)
      CHARACTER*12 ZONE1,ZONE2,ZONE3,ZONF1,ZONF2,ZONF3
      CHARACTER*29 MESSAG
      CHARACTER*9 KEGEND(5)
      ZTR(1)=0
      ZTR(2)=0
      IMOD=0
      NBCON=KON(/1)
      NBCONR=NBCON-1
*  RECHERCHE DU POINT
      CALL mopf3
      CALL TRMESS('Pointez le point')
  30  CONTINUE
      CALL TRDIG(X,Y,INCLE)
      IF (INCLE.EQ.3) RETURN
*  CHERCHER LE POINT DU MAILLAGE
      NBP=XPROJ(/2)
      CRIT=XPREC**2
      DO 10 IP=1,NBP
      IF (IVU(IP).NE.1) GOTO 10
      DIST=(XPROJ(1,IP)-X)**2+(XPROJ(2,IP)-Y)**2
      IF (DIST.LT.CRIT) GOTO 20
  10  CONTINUE
      GOTO 30
  20  CONTINUE
      IPREL=IDCP(IP)
      IREF=(IPREL-1)*(IDIM+1)
      MESSAG='Coordonnees du point'
      WRITE (MESSAG(23:28),FMT='(I6)') IPREL
      ZONE1=' '
      ZONE2=' '
      ZONE3=' '
      WRITE (ZONE2,FMT='(E12.6)') XCOOR(2+IREF)
      IF (IDIM.EQ.3) THEN
       WRITE (ZONE3,FMT='(E12.6)') XCOOR(3+IREF)
      ENDIF
      WRITE (ZONE1,FMT='(E12.6)') XCOOR(1+IREF)
      CALL TRMESS(MESSAG//ZONE1//ZONE2//ZONE3)
      GOTO 90
  80  CONTINUE
      CALL TRMESS('Valeur incorrecte')
  90  CONTINUE
      KEGEND(1)=' '
      KEGEND(2)='Changer X'
      KEGEND(3)='Changer Y'
      KEGEND(4)='Changer Z'
      IF (IDIM.NE.3) KEGEND(4)=' '
      KEGEND(5)='Continuer'
      CALL MENU(KEGEND,4,9)
      CALL TRAFF(ICLE)
      IF (ICLE.EQ.1) THEN
      CALL TRGET('Indiquer le nouveau X :',ZONF1)
      READ(ZONF1,FMT='(E12.6)',ERR=80) XCOOR(1+IREF)
      IMOD=1
      ENDIF
      IF (ICLE.EQ.2) THEN
      CALL TRGET('Indiquer le nouveau Y :',ZONF2)
      READ(ZONF2,FMT='(E12.6)',ERR=80) XCOOR(2+IREF)
      IMOD=1
      ENDIF
      IF (IDIM.EQ.3) THEN
      IF (ICLE.EQ.3) THEN
      CALL TRGET('Indiquer le nouveau Z :',ZONF3)
      READ(ZONF3,FMT='(E12.6)',ERR=80) XCOOR(3+IREF)
      IMOD=1
      ENDIF
      ENDIF
*  REAFFICHER LES LIGNES MODIFIES
      IF (IMOD.EQ.0) RETURN
      CALL PROMOD(ICPR,XPROJ,IPREL,3,IBOUJ)
      CALL CHCOUL(4)
      X=XPROJ(1,IP)
      Y=XPROJ(2,IP)
      ICHAIN=IP
  70  CONTINUE
      DO 50 ICON=1,NBCONR
      IP=KON(ICON,ICHAIN)
      IF (IP.EQ.0) GOTO 60
      XTR(1)=X
      YTR(1)=Y
      XTR(2)=XPROJ(1,IP)
      YTR(2)=XPROJ(2,IP)
      CALL POLRL(2,XTR,YTR,ZTR)
  50  CONTINUE
      ICHAIN=KON(NBCON,ICHAIN)
      IF (ICHAIN.NE.0) GOTO 70
  60  CONTINUE
      END