Télécharger imppil.eso

Retour à la liste

Numérotation des lignes :

  1. C IMPPIL SOURCE PV 16/11/26 21:15:57 9205
  2. SUBROUTINE IMPPIL (ITOTO,IVOULU)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C=======================================================================
  6. C CE SUBROUTINE IMPRIME SUR LE FICHIER IOIMP
  7. C LE CONTENU DES PILES
  8. C APPELE PAR SAUV
  9. C APPELLE :
  10. C ECRIT PAR FARVACQUE-LENA
  11. C=======================================================================
  12. C TABLEAU KCOLA :
  13. C 1 MELEME 2 CHPOIN 3 MRIGID 4 MCHAFF 5 MCHELM 6
  14. C 77 8 MSOLUT 9 MSTRUC 10 11 MAFFEC 12 MSOSTU
  15. C 13 IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL
  16. C 19 MLENTI 20 MCHARG 21 MODELE 22 MEVOLL
  17. C=======================================================================
  18. -INC CCOPTIO
  19. -INC TMCOLAC
  20. C=======================================================================
  21. C ICOLAC : KCOLA : POINTEUR SUR LA PILE ITLACC
  22. C MCOLA : NOMBRE D'OBJETS INSPECTES DANS LA PILE
  23. C ICOLA : POINTEUR SUR ISGTR ( NOM-NOM-RANG DANS ITLACC)
  24. C KCOLAC: CONTIENT POUR CHAQUE PILE LE NOMBRE D'OBJETS A
  25. C SORTIR
  26. C=======================================================================
  27. C
  28. IF (IVOULU.NE.0) THEN
  29. NPIL1=IVOULU
  30. NPIL2= NPIL1
  31. ELSE
  32. ICOLAC=ITOTO
  33. NPIL1=1
  34. SEGACT ICOLAC
  35. NITLAC=ICOLA(/1)
  36. NPIL2=NITLAC
  37. WRITE(IOIMP,900)(ICOLA(I),KCOLA(I),MCOLA(I),
  38. + I=1,NPIL2)
  39. ENDIF
  40.  
  41. DO 2 I=NPIL1,NPIL2
  42. IF (IVOULU.EQ.0) THEN
  43. ITLACC=KCOLA(I)
  44. segact itlacc
  45. ELSE
  46. ITLACC=ITOTO
  47. ENDIF
  48. N1=ITLAC(/1)
  49. WRITE(IOIMP,901) I,N1
  50. IF(I.EQ.38) WRITE(6,*) (ITLAC(KO),KO=1,N1)
  51. IF (IVOULU.NE.0) GO TO 2
  52.  
  53. ISGTR=ICOLA(I)
  54. IF(ISGTR.EQ.0) GO TO 1
  55. segact isgtr
  56. WRITE(IOIMP,906)
  57. NTOTO=ISGTRI(/1)
  58. IF (NTOTO.NE.0) THEN
  59. DO 9 K=1,NTOTO
  60. WRITE(IOIMP,905) ISGTRC(K),ISGTRI(K)
  61. 9 CONTINUE
  62. ENDIF
  63. 1 CONTINUE
  64. 2 CONTINUE
  65. IF (IVOULU.EQ.0) SEGDES ICOLAC
  66. RETURN
  67. C
  68. 900 FORMAT(' SEGMENT ICOLAC ,TETE DES PILES'/(1X,3I8) )
  69. 901 FORMAT(' PILE NUMERO=',I4,' . IL Y A ',I5,' TERMES.')
  70. 902 FORMAT(6I12)
  71. 906 FORMAT(' TABLES DES NOMS-POINTEURS ASSOCIES')
  72. 905 FORMAT(2X,A8,1X,I8)
  73. C
  74. END
  75.  
  76.  
  77.  
  78.  
  79.  
  80.  
  81.  
  82.  
  83.  
  84.  
  85.  

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