Télécharger moco.eso

Retour à la liste

Numérotation des lignes :

  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
  25. CALL mopf3
  26. CALL TRMESS('Pointez le point')
  27. 30 CONTINUE
  28. CALL TRDIG(X,Y,INCLE)
  29. IF (INCLE.EQ.3) RETURN
  30. * CHERCHER LE POINT DU MAILLAGE
  31. NBP=XPROJ(/2)
  32. CRIT=XPREC**2
  33. DO 10 IP=1,NBP
  34. IF (IVU(IP).NE.1) GOTO 10
  35. DIST=(XPROJ(1,IP)-X)**2+(XPROJ(2,IP)-Y)**2
  36. IF (DIST.LT.CRIT) GOTO 20
  37. 10 CONTINUE
  38. GOTO 30
  39. 20 CONTINUE
  40. IPREL=IDCP(IP)
  41. IREF=(IPREL-1)*(IDIM+1)
  42. MESSAG='Coordonnees du point'
  43. WRITE (MESSAG(23:28),FMT='(I6)') IPREL
  44. ZONE1=' '
  45. ZONE2=' '
  46. ZONE3=' '
  47. WRITE (ZONE2,FMT='(E12.6)') XCOOR(2+IREF)
  48. IF (IDIM.EQ.3) THEN
  49. WRITE (ZONE3,FMT='(E12.6)') XCOOR(3+IREF)
  50. ENDIF
  51. WRITE (ZONE1,FMT='(E12.6)') XCOOR(1+IREF)
  52. CALL TRMESS(MESSAG//ZONE1//ZONE2//ZONE3)
  53. GOTO 90
  54. 80 CONTINUE
  55. CALL TRMESS('Valeur incorrecte')
  56. 90 CONTINUE
  57. KEGEND(1)=' '
  58. KEGEND(2)='Changer X'
  59. KEGEND(3)='Changer Y'
  60. KEGEND(4)='Changer Z'
  61. IF (IDIM.NE.3) KEGEND(4)=' '
  62. KEGEND(5)='Continuer'
  63. CALL MENU(KEGEND,4,9)
  64. CALL TRAFF(ICLE)
  65. IF (ICLE.EQ.1) THEN
  66. CALL TRGET('Indiquer le nouveau X :',ZONF1)
  67. READ(ZONF1,FMT='(E12.6)',ERR=80) XCOOR(1+IREF)
  68. IMOD=1
  69. ENDIF
  70. IF (ICLE.EQ.2) THEN
  71. CALL TRGET('Indiquer le nouveau Y :',ZONF2)
  72. READ(ZONF2,FMT='(E12.6)',ERR=80) XCOOR(2+IREF)
  73. IMOD=1
  74. ENDIF
  75. IF (IDIM.EQ.3) THEN
  76. IF (ICLE.EQ.3) THEN
  77. CALL TRGET('Indiquer le nouveau Z :',ZONF3)
  78. READ(ZONF3,FMT='(E12.6)',ERR=80) XCOOR(3+IREF)
  79. IMOD=1
  80. ENDIF
  81. ENDIF
  82. * REAFFICHER LES LIGNES MODIFIES
  83. IF (IMOD.EQ.0) RETURN
  84. CALL PROMOD(ICPR,XPROJ,IPREL,3,IBOUJ)
  85. CALL CHCOUL(4)
  86. X=XPROJ(1,IP)
  87. Y=XPROJ(2,IP)
  88. ICHAIN=IP
  89. 70 CONTINUE
  90. DO 50 ICON=1,NBCONR
  91. IP=KON(ICON,ICHAIN)
  92. IF (IP.EQ.0) GOTO 60
  93. XTR(1)=X
  94. YTR(1)=Y
  95. XTR(2)=XPROJ(1,IP)
  96. YTR(2)=XPROJ(2,IP)
  97. CALL POLRL(2,XTR,YTR,ZTR)
  98. 50 CONTINUE
  99. ICHAIN=KON(NBCON,ICHAIN)
  100. IF (ICHAIN.NE.0) GOTO 70
  101. 60 CONTINUE
  102. END
  103.  
  104.  
  105.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales