Télécharger la plaquette Cast3M


fr en

Télécharger crepil.eso

Retour à la liste

Numérotation des lignes : 

crepil

  1. C CREPIL    SOURCE    PV        20/03/30    21:16:59     10567          
  2.       SUBROUTINE CREPIL (ICOLAC,NITLAC)
  3. C=======================================================================
  4. C      CE SOUPROGRAMME INITIALISE LES PILES ICOLAC
  5. C
  6. C ENTREE :
  7. C         ICOLAC POINTEUR SUR UN SEGMENT A CREER
  8. C         NITLAC LONGUEUR DE CE SEGMENT= NB DE PILES CREEES
  9. C  PROGRAMME PAR FARVACQUE
  10. C  APPELE PAR SAUV
  11. C  APPELLE :
  12. C=======================================================================
  13. C  TABLEAU KCOLA :
  14. C    1  MELEME  2 CHPOIN  3 MRIGID  4 MCHAFF  5 MCHELM  6
  15. C    7          8 MSOLUT  9 MSTRUC 10        11 MAFFEC 12 MSOSTU
  16. C   13  IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL
  17. C   19  MLENTI 20 MCHARG 21 MODELE 22 MEVOLL
  18. C=======================================================================
  19. C
  20.       IMPLICIT INTEGER(I-N)
  21.  
  22. -INC PPARAM
  23. -INC CCOPTIO
  24. -INC CCASSIS
  25. -INC CCNOYAU
  26. -INC TMCOLAC
  27. -INC SMCOORD
  28. C
  29. C=======================================================================
  30. C  ICOLAC :  KCOLA : POINTEUR SUR LA PILE ITLACC
  31. C            MCOLA : NOMBRE D'OBJETS INSPECTES DANS LA PILE
  32. C            ICOLA : POINTEUR SUR ISGTR ( NOM-NOM-RANG DANS ITLACC)
  33. C            KCOLAC: CONTIENT POUR CHAQUE PILE LE NOMBRE D'OBJETS A
  34. C                    SORTIR
  35. C=======================================================================
  36. C
  37. C
  38. C  **** INITIALISATION DE ICOLAC
  39. C
  40.       segment IBIDD(NP)
  41.       CALL OOOLIS(IBIDD)
  42.       SEGACT IBIDD
  43. **     write(6,*) ' taille de ibidd',ibidd(/1)
  44.       nlisse=0
  45.       ipgcd=ibidd(1)-1
  46.       DO 1,I=1,IBIDD(/1)
  47.        nlisse=max(nlisse,ibidd(I))
  48.        if (i.gt.1) ipgcd=min(ipgcd,abs(ibidd(i)-ibidd(i-1)))
  49.   1   CONTINUE
  50.       SEGINI ICOLAC
  51. *      write(6,*) 'icolac nlisse',icolac,nlisse
  52. *      write(6,*) 'icolac pgcd  ',icolac,ipgcd
  53. *      NLISSE = ICOLAC
  54.       nlisse=(nlisse-1)/ipgcd
  55.       SEGINI ILISSE
  56.       npgcd=ipgcd
  57.       ILISSG=ILISSE
  58.       segact mcoord
  59.       nlisse=nbpts
  60.       segini ilisse
  61.       ilissp=ilisse
  62.       if(nbesc.ne.0) segact ipiloc
  63.       nlisse=xiflot(/1)
  64.       segini ilisse
  65.       ilissf=ilisse
  66.       DO 300 I=1,NITLAC
  67.  
  68.          SEGINI ITLACC
  69.          KCOLA(I)=ITLACC
  70.  
  71.          KS=0
  72.          SEGINI ISGTR
  73.             ICOLA(I)=ISGTR
  74.  
  75.          MCOLA(I)=0
  76. C         KCOLAC(I)=0
  77.  
  78.  300  CONTINUE
  79.       if(nbesc.ne.0) SEGDES,IPILOC
  80. C
  81. *      SEGDES ICOLAC
  82. *      SEGDES ILISSE
  83. C
  84. C
  85.       RETURN
  86.       END
  87.  
  88.  
  89.  

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