Télécharger la plaquette Cast3M


fr en

Télécharger no2000.eso

Retour à la liste

Numérotation des lignes : 

no2000

  1. C NO2000    SOURCE    JC220346  18/12/04    21:15:48     9991           
  2. C    EDITION DE LA NOTICE CASTEM2000 SUR LE FICHIER LISTING
  3. C
  4.       SUBROUTINE NO2000(KOP,NOP)
  5.       IMPLICIT INTEGER(I-N)
  6.  
  7. -INC PPARAM
  8. -INC CCOPTIO
  9. -INC TMLNOMS
  10. -INC SMTEXTE
  11. -INC CCASSIS
  12.       SEGMENT ITRAV
  13.        CHARACTER*8 MOP(NAP),LOP(NAP)
  14.       ENDSEGMENT
  15.       SEGMENT KTRAV
  16.        CHARACTER*8 MMOP(NN),LLOP(NN)
  17.       ENDSEGMENT
  18.       CHARACTER*4 KOP(NOP)
  19.       CHARACTER*8 MCHAP(8)
  20.       CHARACTER*8 IHH
  21.       DATA NCHAP /8/
  22.       DATA MCHAP/'INTK   ','GIBI   ','EXEM    ','DEBU   ','MECA   ',
  23.      #           'MEC1   ','MEC2    ','OBJE    '/
  24.       WRITE (IOIMP,102)
  25.  102  FORMAT(22X,'NOTICE D''UTILISATION DE CASTEM2000',/,
  26.      #       22X,'**********************************')
  27.       CALL RAZPIL
  28.       DO 1 I=1,NCHAP
  29.       IERR=0
  30.       CALL GINT2
  31.       WRITE (IOIMP,5)
  32.    5  FORMAT(1H1,/,50X,'CEA-DEMT   SYSTEME CASTEM2000')
  33.       WRITE (IOIMP,10) MCHAP(I)
  34.   10  FORMAT(20X,'CHAPITRE ',A8,////)
  35.       CALL ECRCHA(MCHAP(I))
  36.       CALL INFORM
  37.    1  CONTINUE
  38.       NAP = NOP
  39. C  FAIRE EVENTUELLEMENT LE TRI ALPHABETIQUE
  40.       SEGINI ITRAV
  41.       DO 30 I=1,NOP
  42.        MOP(I)=KOP(I)
  43.   30  CONTINUE
  44.       CALL TRIDEP(MOP,LOP,NAP)
  45. C   IMPRESSION DE LA LISTE DES OPERATEURS
  46.       WRITE (IOIMP,5)
  47.       WRITE (IOIMP,131)
  48.  131  FORMAT(20X,'LISTE DE TOUS LES OPERATEURS  '/
  49.      .       20X,'****************************'////)
  50.       WRITE(IOIMP,132) (MOP(I),I=1,NOP)
  51.  132  FORMAT(6(4X,A8)/)
  52. *
  53. *  AU TOUR DES PROCEDURES
  54. *
  55.       CALL REPLIS('PROCEDUR',MLNOMS)
  56.       SEGACT MLNOMS
  57.       NN=LINOMS(/2)
  58.       SEGINI KTRAV
  59.       DO 31 I=1,NN
  60.       MMOP(I)=LINOMS(I)
  61.   31  CONTINUE
  62.       CALL TRIDEP(MMOP,LLOP,NN)
  63.       WRITE (IOIMP,5)
  64.       WRITE (IOIMP,134)
  65.  134  FORMAT(20X,'LISTE DE TOUTES LES PROCEDURES  '/
  66.      .       20X,'******************************'////)
  67.       WRITE(IOIMP,132) (MMOP(I),I=1,NN)
  68. *
  69. *   ECRITURE DES NOTICES D'OPERATEUR
  70. *
  71.       DO 2 I=1,NOP
  72.         IHH=MOP(I)
  73.         DO 3 J=1,NCHAP
  74.          IF (IHH.EQ.MCHAP(J)) GOTO 2
  75.   3     CONTINUE
  76.       IERR=0
  77.       CALL GINT2
  78.       WRITE (IOIMP,5)
  79.       WRITE (IOIMP,10) MOP(I)
  80.       CALL ECRCHA(IHH)
  81.       CALL INFORM
  82.    2  CONTINUE
  83. *
  84. *   ECRITURE DES NOTICES DE PROCEDURE
  85. *
  86.       DO 7 I=1,NN
  87.         IHH=MMOP(I)
  88.         DO 8 J=1,NCHAP
  89.          IF (IHH.EQ.MCHAP(J)) GOTO 7
  90.   8     CONTINUE
  91.       IERR=0
  92.       CALL GINT2
  93.       WRITE (IOIMP,5)
  94.       WRITE (IOIMP,10) MMOP(I)
  95.       SEGINI MTEXTE
  96.       NCART=8
  97.       MTEXT(1:8)=IHH
  98.       CALL ECROBJ('TEXTE',MTEXTE)
  99.       CALL INFORM
  100.       SEGSUP MTEXTE
  101.    7  CONTINUE
  102.       WRITE (IOIMP,20)
  103.   20  FORMAT (1H1)
  104.       SEGSUP ITRAV,KTRAV
  105.       RETURN
  106.       END
  107.  
  108.  
  109.  
  110.  
  111.  

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