Télécharger no2000.eso

Retour à la liste

Numérotation des lignes :

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

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