Sources Esope | Cast3M

tasree
C TASREE    SOURCE    CB215821  18/09/13    21:16:28     9917           
C  RETASSER LA PILE DES REELS EN NE GARDANT QUE CE QUI EST NOMME
C  et ceux qui sont sauves
      SUBROUTINE TASREE
      IMPLICIT INTEGER(I-N)
-INC CCNOYAU
-INC TMCOLAC
 
-INC PPARAM
-INC CCOPTIO
-INC CCASSIS
      SAVE LMNRAN
*tc      save ifoiss
      DATA LMNRAN/0/
*tc      data ifoiss/0/
*  XIFLOT SEGMENT DES VALEURS
*  IOUEP2 POSITION DANS LE SUSDIT
      LM=LMNREE+100
      ilop= sqrt( 25. * lmnnom)
      IF(LMNRAN.GT.LMNREE-ilop) RETURN
*tc      ifoiss=ifoiss+1
*      ifoecr=mod(ifoiss, 20)
*      if(ifoecr.eq.1)then
*        write(6,*)'tasree lmnree lmnnom ifoiss',lmnree,lmnnom,ifoiss,
*     $  ilop
*tc      endif
      IF (IIFLOT(/1).LT.LMNREE) SEGADJ IPTRA
      DO 5 I=1,LMNREE
       IIFLOT(I)=0
   5  CONTINUE
 
 
*  LISTE DES VALEURS UTILES
      DO 10 I=1,LMNNOM
       IF (INOOB2(I).NE.'FLOTTANT') GOTO 10
       IIFLOT(IOUEP2(I))=1
  10  CONTINUE
      IF ( IPSAUV.NE.0) THEN
         ICOLAC=IPSAUV
         SEGACT ICOLAC
         ITLACC = KCOLA(25)
         SEGACT ITLACC*MOD
         IPS = ITLAC(/1)
         DO 50 I=1,IPS
         IIFLOT(ITLAC(I))=1
   50    CONTINUE
      ENDIF
      IRANG=0
*  LA COMPACTER
      DO 20 I=1,LMNREE
       IF (IIFLOT(I).NE.0) THEN
          IRANG=IRANG+1
          IIFLOT(I)=IRANG
       ENDIF
  20  CONTINUE
*  RIEN A FAIRE ??
      LMNRAN=LMNREE
      IF (IRANG.EQ.LMNREE) RETURN
*  ACTUALISER LES NOMS
      DO 30 I=1,LMNNOM
       IF (INOOB2(I).NE.'FLOTTANT') GOTO 30
       IOUEP2(I)=IIFLOT(IOUEP2(I))
  30  CONTINUE
       IF(IPSAUV.NE.0)  THEN
          DO 31 I = 1,IPS
          ITLAC(I)= IIFLOT(ITLAC(I))
  31      CONTINUE
C          SEGDES ITLACC
C          SEGDES ICOLAC
       ENDIF
*  ACTUALISER LES VALEURS
      segact ipiloc*mod
      DO 40 I=1,LMNREE
       IF (IIFLOT(I).EQ.0) GOTO 40
       XIFLOT(IIFLOT(I))=XIFLOT(I)
  40  CONTINUE
      if(nbesc.ne.0) SEGDES,IPILOC
*  ACTUALISER LA TAILLE
      LMNREE=IRANG
      LMNRAN=LMNREE
      END