Sources Esope | Cast3M

klop
C KLOP      SOURCE    CHAT      05/01/13    00:56:56     5004
      SUBROUTINE KLOP
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C*************************************************************************
C
C    Operateur KLOP
C
C    Objet : retourne le nom d'un operateur TRIO contenu dans la liste
C            au rang IND ainsi que la table associée a cet opérateur
C
C    Syntaxe (usuelle) :  KLOP RV IND &lt;IMPR> ;
C
C     RV    : objet de type table soustype EQEX ou EQPR
C     IND   : ENTIER
C
C  en retour on a le nom (type MOT) et la table
C  IMPR : impression du nom de l'opérateur exécuté
C*************************************************************************
-INC SMTABLE
-INC SMLMOTS
      CHARACTER*8 NOM,TYPE,NOMT
      CHARACTER*4 LISMO(1)
      DATA LISMO/'IMPR'/
C***
 
      CALL LIRENT(IND,1,IRET)
      IF(IRET.EQ.0)RETURN
      CALL LIROBJ('TABLE',MTABLE,1,IRET)
      IF(IRET.EQ.0)RETURN
      SEGACT MTABLE
      TYPE=' '
      CALL ACMO(MTABLE,'LISTOPER',TYPE,MLMOTS)
      IF(TYPE.NE.'LISTMOTS')THEN
      WRITE(6,*)' Il n''y a pas d''entree LISTOPER dans la table'
      RETURN
      ENDIF
      IMPR=0
      CALL LIRMOT(LISMO,1,IP,0)
      IMPR=IP
      SEGACT MLMOTS
      NBM=MOTS(/2)
      IF(IND.GT.NBM)THEN
      WRITE(6,*)' L''indice ',IND,' est superieur au nombre de mots ',
     &NBM
      RETURN
      ENDIF
      NOMT=MOTS(IND)
      NOM=' '
      IF(IND.LT.10)THEN
      NOM=MOTS(IND)(2:8)
      ELSE
      NOM=MOTS(IND)(3:8)
      ENDIF
      CALL LENCHA(NOMT,LCT)
      TYPE=' '
      CALL ACMO(MTABLE,NOMT(1:LCT),TYPE,MTABX)
      IF(TYPE.NE.'TABLE')THEN
      WRITE(6,*)' On a pas trouve d''objet de type TABLE correspondant'
     &,' a l indice ',NOMT
      RETURN
      ENDIF
      IF(IMPR.EQ.1)WRITE(6,*)' Opérateur :',MOTS(IND)
      SEGDES MTABLE,MLMOTS
      CALL LENCHA(NOM,LC1)
      CALL ECRCHA(NOM(1:LC1))
      CALL ECROBJ('TABLE',MTABX)
      RETURN
      END