Télécharger klop.eso

Retour à la liste

Numérotation des lignes :

klop
  1. C KLOP SOURCE CHAT 05/01/13 00:56:56 5004
  2. SUBROUTINE KLOP
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C*************************************************************************
  6. C
  7. C Operateur KLOP
  8. C
  9. C Objet : retourne le nom d'un operateur TRIO contenu dans la liste
  10. C au rang IND ainsi que la table associée a cet opérateur
  11. C
  12. C Syntaxe (usuelle) : KLOP RV IND <IMPR> ;
  13. C
  14. C RV : objet de type table soustype EQEX ou EQPR
  15. C IND : ENTIER
  16. C
  17. C en retour on a le nom (type MOT) et la table
  18. C IMPR : impression du nom de l'opérateur exécuté
  19. C*************************************************************************
  20. -INC SMTABLE
  21. -INC SMLMOTS
  22. CHARACTER*8 NOM,TYPE,NOMT
  23. CHARACTER*4 LISMO(1)
  24. DATA LISMO/'IMPR'/
  25. C***
  26.  
  27. CALL LIRENT(IND,1,IRET)
  28. IF(IRET.EQ.0)RETURN
  29. CALL LIROBJ('TABLE',MTABLE,1,IRET)
  30. IF(IRET.EQ.0)RETURN
  31. SEGACT MTABLE
  32. TYPE=' '
  33. CALL ACMO(MTABLE,'LISTOPER',TYPE,MLMOTS)
  34. IF(TYPE.NE.'LISTMOTS')THEN
  35. WRITE(6,*)' Il n''y a pas d''entree LISTOPER dans la table'
  36. RETURN
  37. ENDIF
  38. IMPR=0
  39. CALL LIRMOT(LISMO,1,IP,0)
  40. IMPR=IP
  41. SEGACT MLMOTS
  42. NBM=MOTS(/2)
  43. IF(IND.GT.NBM)THEN
  44. WRITE(6,*)' L''indice ',IND,' est superieur au nombre de mots ',
  45. &NBM
  46. RETURN
  47. ENDIF
  48. NOMT=MOTS(IND)
  49. NOM=' '
  50. IF(IND.LT.10)THEN
  51. NOM=MOTS(IND)(2:8)
  52. ELSE
  53. NOM=MOTS(IND)(3:8)
  54. ENDIF
  55. CALL LENCHA(NOMT,LCT)
  56. TYPE=' '
  57. CALL ACMO(MTABLE,NOMT(1:LCT),TYPE,MTABX)
  58. IF(TYPE.NE.'TABLE')THEN
  59. WRITE(6,*)' On a pas trouve d''objet de type TABLE correspondant'
  60. &,' a l indice ',NOMT
  61. RETURN
  62. ENDIF
  63. IF(IMPR.EQ.1)WRITE(6,*)' Opérateur :',MOTS(IND)
  64. SEGDES MTABLE,MLMOTS
  65. CALL LENCHA(NOM,LC1)
  66. CALL ECRCHA(NOM(1:LC1))
  67. CALL ECROBJ('TABLE',MTABX)
  68. RETURN
  69. END
  70.  
  71.  

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