Numérotation des lignes :

C MENAG7    SOURCE    PV        17/12/05    21:16:51     9646                 SUBROUTINE MENAG7(icolac,jcolac)CC elimine des itlac deja sauves ceux qui n'existent plusC      implicit integer(i-n)      integer i, ifi, ifi1, ima, j, k      integer jcolac      integer lsf, nitlac, nliss1-INC CCOPTIO-INC TMCOLAC      segment iliss1         integer ilise1(nliss1)      endsegment      if(jcolac.eq.0) returnC      call imppil ( ipsauv,0)*      call imppil (jcolac,0)      icola1=jcolac      segact icolacC      write(6,*) "jcolac",jcolac       segact icola1      ilisse=icola1.ilissgC      write(6,*) "ilisse",ilisse      segact ilisse*mod      nitlac=icola1.kcola(/1)      nliss1=0      segini iliss1      do 1 k=1,nitlac         if(k.ge.24.and.k.le.28) go to 1         if(k.eq.32) go to 1         if(k.eq.36) go to 1         itlac1=icola1.kcola(k)         itlacc=kcola(k)         segact itlac1*mod         segact itlacc         ifi= itlac(/1)         ifi1=itlac1.itlac(/1)         if( ifi1.eq.0) go to 10*     write (6,*) 'ifi*ifi1 ',ifi,ifi1,ifi*ifi1         lsf=0*     if (ifi*ifi1.gt.65535) then         if (ifi*ifi1.gt.16384) then            lsf=1            do 31 i=1,ifi               ima=itlac(i)               if (ima.gt.nliss1) then                  nliss1=ima*1.2                  segadj iliss1               endif               ilise1(ima)=i31          continue         else            lsf=0         endif*        if(k.eq.41) write(6,*) 'menag7 traitement pile',k,ifi,ifi1         do 2 i=1,ifi1            ima = itlac1.itlac(i)            if(ima.eq.0) go to 2            if (lsf.eq.0) then               do 3 j=1,ifi                  if(ima.eq.itlac(j)) go to 23              continue            else               if (ima.le.ilise1(/1)) then                  j=ilise1(ima)                  if (j.ne.0) then                     if(ima.eq.itlac(j)) go to 2                  endif               endif            endif*        write(6,*) ' suppression de ',ima            itlac1.itlac(i)=0            iliseg(((ima-1)/npgcd))=02        continue10       continue         segdes itlacc,itlac11     continue      segsup iliss1      segdes icola1,icolac,ilisse      return      END

© Cast3M 2003 - Tous droits réservés.
Mentions légales