Télécharger crepil.eso

Retour à la liste

Numérotation des lignes :

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

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