Télécharger crepil.eso

Retour à la liste

Numérotation des lignes :

  1. C CREPIL SOURCE PV 16/11/26 21:15:29 9205
  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. -INC CCOPTIO
  22. -INC TMCOLAC
  23. -INC SMCOORD
  24. C
  25. C=======================================================================
  26. C ICOLAC : KCOLA : POINTEUR SUR LA PILE ITLACC
  27. C MCOLA : NOMBRE D'OBJETS INSPECTES DANS LA PILE
  28. C ICOLA : POINTEUR SUR ISGTR ( NOM-NOM-RANG DANS ITLACC)
  29. C KCOLAC: CONTIENT POUR CHAQUE PILE LE NOMBRE D'OBJETS A
  30. C SORTIR
  31. C=======================================================================
  32. C
  33. C
  34. C **** INITIALISATION DE ICOLAC
  35. C
  36. segment IBIDD(NP)
  37. CALL OOOLIS(IBIDD)
  38. SEGACT IBIDD
  39. ** write(6,*) ' taille de ibidd',ibidd(/1)
  40. nlisse=0
  41. ipgcd=ibidd(1)-1
  42. DO 1,I=1,IBIDD(/1)
  43. nlisse=max(nlisse,ibidd(I))
  44. if (i.gt.1) ipgcd=min(ipgcd,abs(ibidd(i)-ibidd(i-1)))
  45. 1 CONTINUE
  46. SEGINI ICOLAC
  47. * write(6,*) 'icolac nlisse',icolac,nlisse
  48. * write(6,*) 'icolac pgcd ',icolac,ipgcd
  49. * NLISSE = ICOLAC
  50. nlisse=(nlisse-1)/ipgcd
  51. SEGINI ILISSE
  52. npgcd=ipgcd
  53. ILISSG=ILISSE
  54. segact mcoord
  55. nlisse=xcoor(/1)/(idim+1)
  56. segini ilisse
  57. ilissp=ilisse
  58. DO 300 I=1,NITLAC
  59.  
  60. SEGINI ITLACC
  61. KCOLA(I)=ITLACC
  62.  
  63. KS=0
  64. SEGINI ISGTR
  65. ICOLA(I)=ISGTR
  66.  
  67. MCOLA(I)=0
  68. C KCOLAC(I)=0
  69.  
  70. 300 CONTINUE
  71. C
  72. * SEGDES ICOLAC
  73. * SEGDES ILISSE
  74. C
  75. C
  76. RETURN
  77. END
  78.  
  79.  
  80.  
  81.  
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  

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