Sources Esope | Cast3M

modp
C MODP      SOURCE    PV        05/09/22    21:20:54     5181
C   DEPLACEMENT INTERACTIF D'UN NOEUD
C
      SUBROUTINE MODP(XPROJ,IVU,KON1,ICPR,IDCP,IBOUJ)
      IMPLICIT INTEGER(I-N)
      COMMON /CMODI/LIGMAX,XPREC,YPREC
      DIMENSION XTR(2),YTR(2),ZTR(2)
      SEGMENT /KON1/(KON(NBCON,NMAX)),KON2.KON1
      SEGMENT XPROJ(3,ITE)
      SEGMENT IVU(0)
      SEGMENT ICPR(0)
      SEGMENT IDCP(0)
      SEGMENT IBOUJ(0)
      ztr(1)=0
      ztr(2)=0
      NBCON=KON(/1)
      NBCONR=NBCON-1
      CALL TRMESS('POINTEZ LE POINT A DEPLACER')
  30  CONTINUE
      CALL MOPF3
      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
      CALL TRMESS('POINTEZ LA NOUVELLE POSITION DU POINT')
      CALL TRDIG(X,Y,INCLE)
      CALL TRMESS(' ')
      IF (INCLE.EQ.3) RETURN
      XPROJ(1,IP)=X
      XPROJ(2,IP)=Y
      IOEE=IDCP(IP)
      CALL PROMOD(ICPR,XPROJ,IOEE,4,IBOUJ)
*  REAFFICHER LES LIGNES MODIFIES
      call insegt(3,iresu)
      CALL CHCOUL(4)
      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