Esope source files

   1 : C CREPI0    SOURCE    PV        14/02/06    21:15:00     7943           
   2 :       SUBROUTINE CREPI0(ICOLAC)
   3 :       IMPLICIT INTEGER(I-N)
   4 : -INC TMCOLAC
   5 : -INC SMCOORD
   6 : -INC CCOPTIO
   7 :         SEGACT ICOLAC*MOD
   7 :         call ooohor(0,0)
   8 :         DO 2 I=1,KCOLA(/1)
   9 :         ITLACC=KCOLA(I)
  10 :         SEGACT ITLACC*MOD
  11 :         ISGTR=ICOLA(I)
  12 :         SEGACT ISGTR*MOD
  13 : C        write(6,*)' crepi0 itlacc isgtr',itlacc,isgtr 
  14 :     2   CONTINUE
  15 : * pour les piles entiers flottant mot logique on réecrit tout
  16 :         ks=0
  17 :         do i=24,27
  18 :           itlacc=kcola(i) 
  19 :           segsup itlacc 
  20 :           segini itlacc
  21 :           mcola(i)=0
  22 :           kcola(i)=itlacc
  23 :           ISGTR=ICOLA(I)
  24 :           segsup isgtr
  25 :           segini isgtr
  26 :           icola(i)=isgtr
  27 :           kcolac(i)=0
  28 :         enddo   
  29 :         
  30 :         ILISSE = ILISSG
  31 :         SEGACT ILISSE*MOD
  32 : *
  33 : * pour les piles des tables (N° 10) et des OBJETS(N° 44) on
  34 : * duplique les objets existants AU niveau de l'attribution des noms
  35 : * il faudra parcourir la pile en sens inverse
  36 : *  idem pour les config
  37 :       ITLACC=KCOLA(10)
  38 :       IN=ITLAC(/1)
  39 :       IF(IN.NE.0) THEN
  40 :         DO 1 J=1,IN
  41 :          IF(ITLAC(J).NE.0) THEN
  42 : *           ITLAC(**)=ITLAC(J)
  43 :             ILISEG((ITLAC(J)-1)/npgcd)=0
  44 :            ITLAC(J)=0
  45 :          ENDIF
  46 :     1   CONTINUE
  47 :       ENDIF
  48 :       ITLACC=KCOLA(44)
  49 :       IN=ITLAC(/1)
  50 :       IF(IN.NE.0) THEN
  51 :         DO 3 J=1,IN
  52 :          IF(ITLAC(J).NE.0) THEN
  53 : *           ITLAC(**)=ITLAC(J)
  54 :             ILISEG((ITLAC(J)-1)/npgcd)=0
  55 :            ITLAC(J)=0
  56 :          ENDIF
  57 :     3   CONTINUE
  58 :       ENDIF
  59 : C pour les configu on met en premier la configuration courante
  60 :       ITLACC=KCOLA(33)
  61 : *      ITLAC(**)=MCOORD
  62 :       IN=ITLAC(/1)
  63 : ****  IF(IN.NE.1) THEN
  64 : * on resauve toujours la configuration courante au cas ou il y ait eu renumerotation
  65 :         DO 4 J=1,IN
  66 :          IF(ITLAC(J).NE.0) THEN
  67 : *           IF(ITLAC(J).NE.MCOORD)ITLAC(**)=ITLAC(J)
  68 :            ILISEG((ITLAC(J)-1)/npgcd)=0
  69 :            ITLAC(J)=0
  70 :          ENDIF
  71 :     4   CONTINUE
  72 : **    ENDIF
  73 :       RETURN
  74 :       END
  75 :  
  76 :  
  77 :  
  78 :  
  79 :  
  80 :  
  81 :  
  82 :  
  83 :  
  84 :