Télécharger la plaquette Cast3M


fr en

Télécharger imppil.eso

Retour à la liste

Numérotation des lignes : 

imppil

  1. C IMPPIL    SOURCE    JC220346  18/12/04    21:15:28     9991           
  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.  
  19. -INC PPARAM
  20. -INC CCOPTIO
  21. -INC TMCOLAC
  22. C=======================================================================
  23. C  ICOLAC :  KCOLA : POINTEUR SUR LA PILE ITLACC
  24. C            MCOLA : NOMBRE D'OBJETS INSPECTES DANS LA PILE
  25. C            ICOLA : POINTEUR SUR ISGTR ( NOM-NOM-RANG DANS ITLACC)
  26. C            KCOLAC: CONTIENT POUR CHAQUE PILE LE NOMBRE D'OBJETS A
  27. C                    SORTIR
  28. C=======================================================================
  29. C
  30.       IF (IVOULU.NE.0) THEN
  31.          NPIL1=IVOULU
  32.          NPIL2= NPIL1
  33.       ELSE
  34.          ICOLAC=ITOTO
  35.          NPIL1=1
  36.          SEGACT ICOLAC
  37.          NITLAC=ICOLA(/1)
  38.          NPIL2=NITLAC
  39.          WRITE(IOIMP,900)(ICOLA(I),KCOLA(I),MCOLA(I),
  40.      +                                               I=1,NPIL2)
  41.       ENDIF
  42.  
  43.       DO 2 I=NPIL1,NPIL2
  44.          IF (IVOULU.EQ.0) THEN
  45.             ITLACC=KCOLA(I)
  46.             segact itlacc
  47.          ELSE
  48.             ITLACC=ITOTO
  49.          ENDIF
  50.          N1=ITLAC(/1)
  51.          WRITE(IOIMP,901) I,N1
  52.          IF(I.EQ.38)  WRITE(6,*) (ITLAC(KO),KO=1,N1)
  53.          IF (IVOULU.NE.0) GO TO 2
  54.  
  55.          ISGTR=ICOLA(I)
  56.          IF(ISGTR.EQ.0) GO TO 1
  57.          segact isgtr
  58.          WRITE(IOIMP,906)
  59.          NTOTO=ISGTRI(/1)
  60.          IF (NTOTO.NE.0) THEN
  61.             DO 9 K=1,NTOTO
  62.                WRITE(IOIMP,905) ISGTRC(K),ISGTRI(K)
  63.  9          CONTINUE
  64.          ENDIF
  65.  1       CONTINUE
  66.  2    CONTINUE
  67.       IF (IVOULU.EQ.0) SEGDES ICOLAC
  68.       RETURN
  69. C
  70.  900  FORMAT(' SEGMENT ICOLAC ,TETE DES PILES'/(1X,3I8) )
  71.  901  FORMAT('  PILE NUMERO=',I4,'  . IL Y A ',I5,'  TERMES.')
  72.  902  FORMAT(6I12)
  73.  906  FORMAT(' TABLES DES  NOMS-POINTEURS ASSOCIES')
  74.  905  FORMAT(2X,A24,1X,I8)
  75. C
  76.       END
  77.  
  78.  
  79.  
  80.  
  81.  
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  
  88.  
  89.  

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