Esope source files

   1 : C CREPOI    SOURCE    CHAT      09/04/08    21:15:23     6355           
   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 : 
  23 :       IF ((NBNOM.GT.1).AND.(NBNOM.NE.3)) RETURN
  24 :       IF (NBNOM.EQ.3) THEN
  25 :         ITBNOM=ITANO1(1)
  26 :         IF (INOOB2(ITBNOM).NE.'TABLE   ') RETURN
  27 :         ITBNOM=ITANO1(2)
  28 :         IF (INOOB2(ITBNOM).NE.'SEPARATE') RETURN
  29 :       ENDIF
  30 : 
  30 :       CALL MESLIR(-149)
  30 :       CALL LIRREE(Val1,0,IRetou)
  31 :       IF (IRetou.EQ.0) RETURN
  31 :       CALL MESLIR(-150)
  31 :       CALL LIRREE(Val2,0,IRetou)
  32 :       IF (IRetou.NE.1) THEN
  32 :         CALL REFUS
  33 :         RETURN
  34 :       ENDIF
  34 :       CALL MESLIR(-151)
  34 :       IF (IDIM.EQ.3) CALL LIRREE(Val3,1,IRetou)
  35 :       IF (IERR.NE.0) RETURN
  36 : 
  37 :       SEGDES MCOORD
  38 :       SEGACT MCOORD*MOD
  39 :       NbPts=1+(XCOOR(/1)/(IDIM+1))
  40 :       SEGADJ MCOORD
  41 :       IRef=(NbPts-1)*(IDIM+1)
  42 :       XCOOR(IRef+1)=Val1
  43 :       XCOOR(IRef+2)=Val2
  44 :       IF (IDIM.EQ.3) XCOOR(IRef+3)=Val3
  45 :       XCOOR(NbPts*(IDIM+1))=DENSIT
  46 :       segdes MCOORD
  47 :       segact mcoord
  47 :       CALL ECROBJ('POINT   ',NbPts)
  48 :       
  49 :       RETURN
  50 :       END
  51 :  
  52 :