Télécharger la plaquette Cast3M


fr en

Télécharger chtcha.eso

Retour à la liste

Numérotation des lignes : 

chtcha

  1. C CHTCHA    SOURCE    CHAT      05/01/12    22:02:12     5004
  2.       SUBROUTINE CHTCHA(MCHA,LCHALU,IBO,IRET)
  3. C====================================================================
  4. C     SUBROUTINE  POUR CHERCHER DANS UNE TABLE DE SOUSTYPE
  5. C    "RESULTAT DE DYNE"
  6. C     SI LE CHAMP MCHA EXISTE ET EN SORTIR LA POSITION IRET
  7. C       MCHA     (E) CHAINE CHERCHEE
  8. C       LCHALU   (E) LONGUEUR DE CETTE CHAINE
  9. C       IBO      (E) POINTEUR SUR LA TABLE DONT ON PART
  10. C       IRET     (S) POSITION DE CETTE CHAINE DANS L TABLE
  11. C                - SI PAS TROUVE IRET =0
  12. C======================================================================
  13.       IMPLICIT INTEGER(I-N)
  14.       IMPLICIT REAL*8(A-H,O-Z)
  15.       CHARACTER*(*) MCHA
  16.       CHARACTER*(40) CHAR1
  17.       CHARACTER*4 MOT,MOMOT
  18.       LOGICAL L0,L1
  19.       CHARACTER*(8) CHAR0
  20.  
  21. -INC PPARAM
  22. -INC CCOPTIO
  23. -INC SMTABLE
  24.       DATA MOT/'MOT '/
  25. C======================================================================
  26. *ON CONSTRUIT LA TABLE DES INDICES DE LA SOUS TABLE DONNEE
  27.          IRET=0
  28.          CALL ECROBJ('TABLE',IBO)
  29.          CALL INDETA
  30.          CALL LIROBJ('TABLE',ITABIN,1,IRETAB)
  31.          IF (IERR.NE.0) RETURN
  32. *
  33. *        Boucle sur les indices de la table MTABLE:
  34. *
  35.          MTABLE=ITABIN
  36.          SEGACT MTABLE
  37.          NINDIC = MLOTAB
  38.          SEGDES MTABLE
  39.          DO 100 INDICE = 1 , NINDIC
  40.          I0= INDICE
  41.          MOMOT=MOT
  42.         CALL ACCTAB(ITABIN,'ENTIER',I0,X0,CHAR0,L0,IRET0,
  43.      *                      MOMOT,I1,X1,CHAR1,L1,IRET1)
  44.          IF (MOMOT.EQ.MOT) THEN
  45.             IF (CHAR1(1:LCHALU).EQ.MCHA) THEN
  46.               IRET=INDICE
  47.               GO TO 110
  48.             ENDIF
  49.          ENDIF
  50.   100 CONTINUE
  51.   110 SEGSUP MTABLE
  52.       RETURN
  53.       END
  54.  
  55.  

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