Télécharger crepoi.eso

Retour à la liste

Numérotation des lignes :

  1. C CREPOI SOURCE PV 18/10/17 11:54:58 9965
  2. C 09/2003 :
  3. C Modification suite a mise en place du cas IDIM = 1.
  4. C S'il reste IDIM nombres a lire (IDIM = 2 ou 3), creation du point
  5. C correspondant uniquement si affectation a un seul nom (d'objet)
  6. C Si IDIM = 1, on quitte directement le sous-programme et, si
  7. C l'utilisateur a fourni plus d'un flottant avec un seul nom, le
  8. C message d'erreur (trop de donnees ...) sera alors affiche.
  9. C Pour creer un point avec IDIM = 1, utiliser l'operateur POINT
  10.  
  11. SUBROUTINE CREPOI
  12.  
  13. IMPLICIT INTEGER(I-N)
  14. IMPLICIT REAL*8 (A-H,O-Z)
  15.  
  16. -INC CCOPTIO
  17. -INC CCGEOME
  18. -INC SMCOORD
  19. -INC CCNOYAU
  20.  
  21. IF ((IDIM.EQ.0) .OR. (IDIM .EQ.1)) RETURN
  22. ith=0
  23. ith=oothrd
  24. if(ith .eq. 0)then
  25. IF ((NBNOM.GT.1).AND.(NBNOM.NE.3)) RETURN
  26.  
  27. IF (NBNOM.EQ.3) THEN
  28. ITBNOM=ITANO1(1)
  29. IF (INOOB2(ITBNOM).NE.'TABLE ') RETURN
  30. ITBNOM=ITANO1(2)
  31. IF (INOOB2(ITBNOM).NE.'SEPARATE') RETURN
  32. ENDIF
  33. endif
  34.  
  35. CALL MESLIR(-149)
  36. CALL LIRREE(Val1,0,IRetou)
  37. IF (IRetou.EQ.0) RETURN
  38. CALL MESLIR(-150)
  39. CALL LIRREE(Val2,0,IRetou)
  40. IF (IRetou.NE.1) THEN
  41. CALL REFUS
  42. RETURN
  43. ENDIF
  44. CALL MESLIR(-151)
  45. IF (IDIM.EQ.3) CALL LIRREE(Val3,1,IRetou)
  46. IF (IERR.NE.0) RETURN
  47.  
  48. SEGACT MCOORD*MOD
  49. NbPts=1+(XCOOR(/1)/(IDIM+1))
  50. SEGADJ MCOORD
  51. IRef=(NbPts-1)*(IDIM+1)
  52. XCOOR(IRef+1)=Val1
  53. XCOOR(IRef+2)=Val2
  54. IF (IDIM.EQ.3) XCOOR(IRef+3)=Val3
  55. XCOOR(NbPts*(IDIM+1))=DENSIT
  56. segact mcoord
  57. CALL ECROBJ('POINT ',NbPts)
  58.  
  59. RETURN
  60. END
  61.  
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  

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