Télécharger chpcoo.eso

Retour à la liste

Numérotation des lignes :

  1. C CHPCOO SOURCE PASCAL 12/12/12 21:15:02 7605
  2. C CREE UN (DES) CHAMP(S) POINT TYPE SCAL A PARTIR DES COORDONNEES.
  3. C
  4. SUBROUTINE CHPCOO (IVAL,MELEME)
  5. C
  6. C IVAL VAUT 1 ON VEUT CREER UN SEUL CHPOINT CONTENANT LA
  7. C 1 ERE COORDONNES DES NOEUDS DE L'OBJET IMELE
  8. C 2 IDEM POUR LA 2 EME COORDONNEES
  9. C 3 IDEM POUR LA 3 EME COORDONNEES
  10. C 0 ON CREE AUTANT DE CHPOINT QUE IDIM
  11. C IMELE EST LE POINTEUR SUR L'OBJET GEOMETRIQUE
  12. C
  13. IMPLICIT INTEGER(I-N)
  14. -INC CCOPTIO
  15. -INC SMELEME
  16. -INC SMCHPOI
  17. -INC SMCOORD
  18. SEGACT MELEME
  19.  
  20. C CAS DU MAILLAGE VIDE
  21. C
  22. ISOU1=LISOUS(/1)
  23. IF (ITYPEL.EQ.0.AND.ISOU1.EQ.0) THEN
  24. SEGDES,MELEME
  25. NAT=1
  26. NSOUPO=0
  27. SEGINI,MCHPOI
  28. MCHPOI.IFOPOI=IFOUR
  29. MCHPOI.JATTRI(1)=1
  30. SEGDES,MCHPOI
  31. CALL ECROBJ('CHPOINT',MCHPOI)
  32. IF (IVAL.EQ.0) THEN
  33. IF (IDIM.EQ.2) THEN
  34. SEGINI,MCHPO1
  35. MCHPO1.IFOPOI=IFOUR
  36. MCHPO1.JATTRI(1)=1
  37. SEGDES,MCHPO1
  38. CALL ECROBJ('CHPOINT',MCHPO1)
  39. ELSEIF (IDIM.EQ.3) THEN
  40. SEGINI,MCHPO1
  41. MCHPO1.IFOPOI=IFOUR
  42. MCHPO1.JATTRI(1)=1
  43. SEGDES,MCHPO1
  44. CALL ECROBJ('CHPOINT',MCHPO1)
  45. SEGINI,MCHPO2
  46. MCHPO2.IFOPOI=IFOUR
  47. MCHPO2.JATTRI(1)=1
  48. SEGDES,MCHPO2
  49. CALL ECROBJ('CHPOINT',MCHPO2)
  50. ENDIF
  51. ENDIF
  52. RETURN
  53. ENDIF
  54. C
  55. C
  56. C
  57. C AUTRES CAS
  58. C
  59. IF( ITYPEL.NE.1) CALL CHANGE (MELEME,1)
  60. NBPOIN=NUM(/2)
  61. SEGACT MCOORD
  62. NDE=1
  63. NFI=IDIM+1
  64. IF(IVAL.NE.0) THEN
  65. NDE=IVAL
  66. NFI=IVAL+1
  67. ENDIF
  68. NSOUPO=1
  69. NC=1
  70. N=NBPOIN
  71. IA=NFI-NDE
  72. DO 10 IAA=1,IA
  73. IRR= NFI-IAA
  74. NAT=1
  75. SEGINI MCHPOI
  76. MOCHDE=' chpoint de coordonnees '
  77. MTYPOI=' '
  78. JATTRI(1) = 1
  79. IPPOI=MCHPOI
  80. SEGINI MSOUPO
  81. SEGINI MPOVAL
  82. IPCHP(1)=MSOUPO
  83. IFOPOI = IFOMOD
  84. SEGDES MCHPOI
  85. NOCOMP(1)='SCAL'
  86. NOHARM(1)=NIFOUR
  87. IGEOC=MELEME
  88. IPOVAL=MPOVAL
  89. SEGDES MSOUPO
  90. DO 1 I= 1 ,N
  91. I1=NUM(1,I)
  92. I2=(I1-1)*(IDIM+1)
  93. VPOCHA(I,1)=XCOOR(I2+IRR)
  94. 1 CONTINUE
  95. SEGDES MPOVAL
  96. CALL ECROBJ('CHPOINT ',IPPOI)
  97. 10 CONTINUE
  98. SEGDES MELEME
  99. RETURN
  100. END
  101.  
  102.  
  103.  

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