Esope source files

   1 : C TASREE    SOURCE    CHAT      11/07/21    21:15:49     7047           
   2 : C  RETASSER LA PILE DES REELS EN NE GARDANT QUE CE QUI EST NOMME
   3 : C  et ceux qui sont sauves 
   4 :       SUBROUTINE TASREE
   5 :       IMPLICIT INTEGER(I-N)
   6 : -INC CCNOYAU
   7 : -INC TMCOLAC
   8 : -INC CCOPTIO
   9 : -INC CCASSIS
  10 :       SAVE LMNRAN
  11 : *tc      save ifoiss
  12 :       DATA LMNRAN/0/
  13 : *tc      data ifoiss/0/
  14 : *  XIFLOT SEGMENT DES VALEURS
  15 : *  IOUEP2 POSITION DANS LE SUSDIT
  16 :       LM=LMNREE+100
  17 :       ilop= sqrt( 25. * lmnnom) 
  18 :       IF(LMNRAN.GT.LMNREE-ilop) RETURN      
  19 : *tc      ifoiss=ifoiss+1
  20 : *      ifoecr=mod(ifoiss, 20)
  21 : *      if(ifoecr.eq.1)then
  22 : *        write(6,*)'tasree lmnree lmnnom ifoiss',lmnree,lmnnom,ifoiss,
  23 : *     $  ilop
  24 : *tc      endif
  25 :       IF (IIFLOT(/1).LT.LMNREE) SEGADJ IPTRA
  26 :       DO 5 I=1,LMNREE
  27 :        IIFLOT(I)=0
  28 :    5  CONTINUE
  29 :      
  30 : 
  31 : *  LISTE DES VALEURS UTILES
  32 :       DO 10 I=1,LMNNOM
  33 :        IF (INOOB2(I).NE.'FLOTTANT') GOTO 10
  34 :        IIFLOT(IOUEP2(I))=1
  35 :   10  CONTINUE
  36 :       IF ( IPSAUV.NE.0) THEN
  37 :          ICOLAC=IPSAUV
  38 :          SEGACT ICOLAC
  39 :          ITLACC = KCOLA(25)
  40 :          SEGACT ITLACC*MOD
  41 :          IPS = ITLAC(/1)
  42 :          DO 50 I=1,IPS
  43 :          IIFLOT(ITLAC(I))=1
  44 :    50    CONTINUE
  45 :       ENDIF
  46 :       IRANG=0
  47 : *  LA COMPACTER
  48 :       DO 20 I=1,LMNREE
  49 :        IF (IIFLOT(I).NE.0) THEN
  50 :           IRANG=IRANG+1
  51 :           IIFLOT(I)=IRANG
  52 :        ENDIF
  53 :   20  CONTINUE
  54 : *  RIEN A FAIRE ??
  55 :       LMNRAN=LMNREE
  56 :       IF (IRANG.EQ.LMNREE) RETURN
  57 : *  ACTUALISER LES NOMS
  58 :       DO 30 I=1,LMNNOM
  59 :        IF (INOOB2(I).NE.'FLOTTANT') GOTO 30
  60 :        IOUEP2(I)=IIFLOT(IOUEP2(I))
  61 :   30  CONTINUE
  62 :        IF(IPSAUV.NE.0)  THEN
  63 :           DO 31 I = 1,IPS
  64 :           ITLAC(I)= IIFLOT(ITLAC(I))
  65 :   31      CONTINUE
  66 : C          SEGDES ITLACC
  67 : C          SEGDES ICOLAC
  68 :        ENDIF 
  69 : *  ACTUALISER LES VALEURS
  70 :       if(nbesc.ne.0) segact ipiloc*mod
  71 :       DO 40 I=1,LMNREE
  72 :        IF (IIFLOT(I).EQ.0) GOTO 40
  73 :        XIFLOT(IIFLOT(I))=XIFLOT(I)
  74 :   40  CONTINUE 
  75 :       if(nbesc.ne.0) segdes ipiloc
  76 : *  ACTUALISER LA TAILLE
  77 :       LMNREE=IRANG
  78 :       LMNRAN=LMNREE
  79 :       END
  80 :  
  81 :  
  82 :