Download klop.eso

Back to the list

   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  ;
  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 : 
  26 :       CALL LIRENT(IND,1,IRET)
  27 :       IF(IRET.EQ.0)RETURN
  27 :       CALL LIROBJ('TABLE',MTABLE,1,IRET)
  28 :       IF(IRET.EQ.0)RETURN
  29 :       SEGACT MTABLE
  30 :       TYPE=' '
  30 :       CALL ACMO(MTABLE,'LISTOPER',TYPE,MLMOTS)
  31 :       IF(TYPE.NE.'LISTMOTS')THEN
  32 :       WRITE(6,*)' Il n''y a pas d''entree LISTOPER dans la table'
  33 :       RETURN
  34 :       ENDIF
  35 :       IMPR=0
  35 :       CALL LIRMOT(LISMO,1,IP,0)
  36 :       IMPR=IP
  37 :       SEGACT MLMOTS
  38 :       NBM=MOTS(/2)
  39 :       IF(IND.GT.NBM)THEN
  40 :       WRITE(6,*)' L''indice ',IND,' est superieur au nombre de mots ',
  41 :      &NBM
  42 :       RETURN
  43 :       ENDIF
  44 :       NOMT=MOTS(IND)
  45 :       NOM=' '
  46 :       IF(IND.LT.10)THEN
  47 :       NOM=MOTS(IND)(2:8)
  48 :       ELSE
  49 :       NOM=MOTS(IND)(3:8)
  50 :       ENDIF
  50 :       CALL LENCHA(NOMT,LCT)
  51 :       TYPE=' '
  51 :       CALL ACMO(MTABLE,NOMT(1:LCT),TYPE,MTABX)
  52 :       IF(TYPE.NE.'TABLE')THEN
  53 :       WRITE(6,*)' On a pas trouve d''objet de type TABLE correspondant'
  54 :      &,' a l indice ',NOMT
  55 :       RETURN
  56 :       ENDIF
  57 :       IF(IMPR.EQ.1)WRITE(6,*)' Opérateur :',MOTS(IND)
  58 :       SEGDES MTABLE,MLMOTS
  58 :       CALL LENCHA(NOM,LC1)
  58 :       CALL ECRCHA(NOM(1:LC1))
  58 :       CALL ECROBJ('TABLE',MTABX)
  59 :       RETURN
  60 :       END
  61 :  

© Cast3M 2003 - All rights reserved.
Disclaimer