1 : C MOCO SOURCE PV 05/09/22 21:19:46 5181 2 : C ECRITURE COORDONNES D'UN POINT 3 : C 4 : SUBROUTINE MOCO(XPROJ,IVU,KON1,IDCP,ICPR,IBOUJ) 5 : IMPLICIT INTEGER(I-N) 6 : SEGMENT XPROJ(3,0) 7 : SEGMENT IVU(0) 8 : SEGMENT IDCP(0) 9 : SEGMENT ICPR(0) 10 : SEGMENT IBOUJ(0) 11 : SEGMENT /KON1/(KON(NBCON,NMAX)),KON2.KON1 12 : -INC CCOPTIO 13 : -INC SMCOORD 14 : COMMON /CMODI/LIGMAX,XPREC,YPREC 15 : DIMENSION XTR(2),YTR(2),ZTR(2) 16 : CHARACTER*12 ZONE1,ZONE2,ZONE3,ZONF1,ZONF2,ZONF3 17 : CHARACTER*29 MESSAG 18 : CHARACTER*9 KEGEND(5) 19 : ZTR(1)=0 20 : ZTR(2)=0 21 : IMOD=0 22 : NBCON=KON(/1) 23 : NBCONR=NBCON-1 24 : * RECHERCHE DU POINT 24 : CALL mopf3 24 : CALL TRMESS('Pointez le point') 25 : 30 CONTINUE 25 : CALL TRDIG(X,Y,INCLE) 26 : IF (INCLE.EQ.3) RETURN 27 : * CHERCHER LE POINT DU MAILLAGE 28 : NBP=XPROJ(/2) 29 : CRIT=XPREC**2 30 : DO 10 IP=1,NBP 31 : IF (IVU(IP).NE.1) GOTO 10 32 : DIST=(XPROJ(1,IP)-X)**2+(XPROJ(2,IP)-Y)**2 33 : IF (DIST.LT.CRIT) GOTO 20 34 : 10 CONTINUE 35 : GOTO 30 36 : 20 CONTINUE 37 : IPREL=IDCP(IP) 38 : IREF=(IPREL-1)*(IDIM+1) 39 : MESSAG='Coordonnees du point' 40 : WRITE (MESSAG(23:28),FMT='(I6)') IPREL 41 : ZONE1=' ' 42 : ZONE2=' ' 43 : ZONE3=' ' 44 : WRITE (ZONE2,FMT='(E12.6)') XCOOR(2+IREF) 45 : IF (IDIM.EQ.3) THEN 46 : WRITE (ZONE3,FMT='(E12.6)') XCOOR(3+IREF) 47 : ENDIF 48 : WRITE (ZONE1,FMT='(E12.6)') XCOOR(1+IREF) 48 : CALL TRMESS(MESSAG//ZONE1//ZONE2//ZONE3) 49 : GOTO 90 50 : 80 CONTINUE 50 : CALL TRMESS('Valeur incorrecte') 51 : 90 CONTINUE 52 : KEGEND(1)=' ' 53 : KEGEND(2)='Changer X' 54 : KEGEND(3)='Changer Y' 55 : KEGEND(4)='Changer Z' 56 : IF (IDIM.NE.3) KEGEND(4)=' ' 57 : KEGEND(5)='Continuer' 57 : CALL MENU(KEGEND,4,9) 57 : CALL TRAFF(ICLE) 58 : IF (ICLE.EQ.1) THEN 58 : CALL TRGET('Indiquer le nouveau X :',ZONF1) 59 : READ(ZONF1,FMT='(E12.6)',ERR=80) XCOOR(1+IREF) 60 : IMOD=1 61 : ENDIF 62 : IF (ICLE.EQ.2) THEN 62 : CALL TRGET('Indiquer le nouveau Y :',ZONF2) 63 : READ(ZONF2,FMT='(E12.6)',ERR=80) XCOOR(2+IREF) 64 : IMOD=1 65 : ENDIF 66 : IF (IDIM.EQ.3) THEN 67 : IF (ICLE.EQ.3) THEN 67 : CALL TRGET('Indiquer le nouveau Z :',ZONF3) 68 : READ(ZONF3,FMT='(E12.6)',ERR=80) XCOOR(3+IREF) 69 : IMOD=1 70 : ENDIF 71 : ENDIF 72 : * REAFFICHER LES LIGNES MODIFIES 73 : IF (IMOD.EQ.0) RETURN 73 : CALL PROMOD(ICPR,XPROJ,IPREL,3,IBOUJ) 73 : CALL CHCOUL(4) 74 : X=XPROJ(1,IP) 75 : Y=XPROJ(2,IP) 76 : ICHAIN=IP 77 : 70 CONTINUE 78 : DO 50 ICON=1,NBCONR 79 : IP=KON(ICON,ICHAIN) 80 : IF (IP.EQ.0) GOTO 60 81 : XTR(1)=X 82 : YTR(1)=Y 83 : XTR(2)=XPROJ(1,IP) 84 : YTR(2)=XPROJ(2,IP) 84 : CALL POLRL(2,XTR,YTR,ZTR) 85 : 50 CONTINUE 86 : ICHAIN=KON(NBCON,ICHAIN) 87 : IF (ICHAIN.NE.0) GOTO 70 88 : 60 CONTINUE 89 : END 90 : 91 :
© Cast3M 2003 - All rights reserved.
Disclaimer