Esope source files

   1 : C LIPOIN    SOURCE    CHAT      05/01/13    01:20:07     5004           
   2 :       SUBROUTINE LIPOIN(IMAX1,NOBJN,NOMM1,NOMM2,NBANC,IRET,IFORM)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8(A-H,O-Z)
   5 : C=======================================================================
   6 : C   BUT         : LECTURE DES COORD
   7 : C                 MISE A LA SUITE DES COORD EXISTANTES
   8 : C                 AJOUT DANS LA TABLE DES OBJETS
   9 : C   APPELLE PAR :  LIPIL
  10 : C   APPELLE     :  LFCDI2 NOMNST
  11 : C   ECRIT PAR FARVACQUE -LENA
  12 : C
  13 : C=======================================================================
  14 : -INC SMCOORD
  15 : -INC CCOPTIO
  16 : C
  17 : C=======================================================================
  18 :       SEGMENT/NOMM1/(NOM1(NOBJN1))
  19 :       SEGMENT NOMM2
  20 :        CHARACTER*(8) NOM2(NOBJN1)
  21 :       ENDSEGMENT
  22 : C
  23 :       CHARACTER*8 NOMM
  24 : C--------------------------------------------------------------------
  25 :       IRET=0
  26 : C --- ON PREND LA TAILLE DES COORD ACTUELLES  S IL Y EN A DEJA
  27 :       SEGACT MCOORD
  28 :       NBANC=XCOOR(/1)/(IDIM+1)
  29 :       NBNOUV=NBANC+IMAX1
  30 :       NBPTS=NBNOUV
  31 : C --- ON AUGMENTE COORD : TAILLE= NBANC+NBRE LU
  32 :       SEGADJ MCOORD
  33 :       NDEBB=NBANC+1
  34 :       LL=NBANC*(IDIM+1)+1
  35 :       L=(IDIM+1)*IMAX1
  35 :       CALL LFCDI2(IORES,L,XCOOR(LL),IRET,IFORM)
  36 :       IF(IRET.NE.0) GOTO 1000
  37 : C ------------------------------------------------
  38 : C --- DANS NOM1 ON A LE NUMERO DU POINT
  39 : C     ON L INCREMENTE DE NBANC AVANT RAJOUT DANS LA TABLE DES OBJETS
  40 :       IF (NOBJN.NE.0) THEN
  41 :          SEGACT NOMM1*MOD,NOMM2
  42 :          DO 18 I=1,NOBJN
  43 :             NOM1(I)=NOM1(I)+NBANC
  44 :             NOMM= NOM2(I)
  45 :             ITTVAL=NOM1(I)
  45 :             CALL NOMOBJ('POINT   ',NOMM,ITTVAL)
  46 : *            WRITE(IOIMP,801) NOMM,NOM1(I)
  47 :   18     CONTINUE
  48 :          SEGDES NOMM1,NOMM2
  49 :     1 ENDIF
  50 :  1000 RETURN
  51 : C ------------------------------------------------
  52 : *  801 FORMAT(2X,'POINT   ',2X,A8,2X,I8)
  53 :       END
  54 :  
  55 :  
  56 :