Sources Esope | Cast3M

indeta
C INDETA    SOURCE    PV090527  25/09/04    07:28:15     12356          
 
C-----------------------------------------------------------------------
C    FABRIQUE L'INDEX D'UNE TABLE              DANS UNE TABLE          |
C    RECUPERE TOUS LES OBJETS NOMMES D'UN TYPE DANS UNE TABLE          |
C-----------------------------------------------------------------------
      SUBROUTINE INDETA
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC CCNOYAU
 
-INC SMTABLE
 
-INC TMLNOMS
 
      LOGICAL LOGI,LVAL
      CHARACTER*(LOCHAI) IMO
      CHARACTER*(LONOM) CNOM
      CHARACTER*8 CTYP,CTYP2,CVAL
 
      PARAMETER (NMO=35)
      CHARACTER*(8) LISMO(NMO)
      DATA LISMO / 'MOT     ','ENTIER  ','FLOTTANT','LOGIQUE ',
     $             'MAILLAGE','LISTENTI','POINT   ','LISTREEL',
     $             'CHPOINT ','RIGIDITE','TEXTE   ','STRUCTUR',
     $             'ATTACHE ','SOLUTION','BASEMODA','OBJET   ',
     $             'LISTOBJE','VECTDOUB','LISTMOTS','DEFORME ',
     $             'LISTCHPO','CHARGEME','EVOLUTIO','ANNOTATI',
     $             'VECTEUR ','TABLE   ','PROCEDUR','ELEMSTRU',
     $             'BLOQSTRU','MCHAML  ','MMODEL  ','ANNULE  ',
     $             'NUAGE   ','MATRIK  ','ESCLAVE ' /
 
C -2- Syntaxe qui fait l'index des objets d'un type Cast3M donne
C     (Indexation par leur nom dans la pile des objets nommes)
      CALL LIRCHA(IMO,0,iretou)
      IF (Iretou.eq.0) goto 200
 
      IF (IMO(1:1).EQ.'*') THEN
        CTYP = IMO(2:9)
C       Lecture OBLIGATOIRE d'un autre MOT
        IF (CTYP .EQ. '        ') THEN
          CALL LIRCHA(IMO,1,iret)
          IF (IERR.NE.0) RETURN
          CTYP = IMO(1:8)
        ENDIF
        CALL PLAMO8(LISMO,NMO,iret,CTYP)
        LOGI = (iret.LE.0)
        MOTERR = '*'//CTYP(1:8)//' '
      ELSE
        LOGI = .TRUE.
        MOTERR = IMO
      ENDIF
      IF (LOGI) THEN
        CALL ERREUR(7)
        WRITE(IOIMP,110) ('  *'//LISMO(ij),ij=1,NMO)
 110    FORMAT(6A)
        RETURN
      ENDIF
 
C     Recuperation de la liste des noms des objets de ce type
      CALL REPLIS(CTYP,MLNOMS)
      IF (IERR.NE.0) RETURN
 
      NB = mlnoms.LINOMS(/2)
      IF (NB .EQ. 0) THEN
C       Cas où la liste est vide
        MOTERR(1:8)=CTYP
        CALL ERREUR(-14)
      ENDIF
 
C     Creation de la TABLE de resultats
      M = 0
      SEGINI,MTAB1
      mtab1.MLOTAB = 0
 
      DO IJ = 1, NB
C         Recherche du numero de pointeur associe au nom
        CNOM = mlnoms.LINOMS(IJ)
        CTYP2='        '
        IVAL=0
        RVAL=0.D0
        CVAL='        '
        LVAL=.FALSE.
        IOBJ=0
        CALL CQUOI(CNOM,CTYP2,IVAL,RVAL,CVAL,LVAL,IOBJ)
 
C       Ecriture dans la table de l'objet de NOM CNOM et de TYPE CTYP
        CTYP2='MOT     '
        CALL ECCTAB(MTAB1,CTYP2,0,0.d0,CNOM,LOGI,0,
     &                    CTYP,IVAL,RVAL,CVAL,LVAL,IOBJ)
      ENDDO
 
      SEGSUP,MLNOMS
      GOTO 900
 200  CONTINUE
C -1- Creation de l'index d'une table
C     (Indexation par des entiers)
      CTYP = 'TABLE   '
      CALL LIROBJ(CTYP,ITAB,1,iret)
      IF (IERR.NE.0) RETURN
 
      MTABLE = ITAB
      SEGACT,MTABLE
      NB = mtable.MLOTAB
 
      M = NB
      SEGINI,MTAB1
      MTAB1.MLOTAB = NB
 
      CTYP = 'ENTIER  '
      DO IJ = 1, NB
        CALL QUERAN(IRET,CTYP,IJ,RVAL,CVAL,LVAL,IOBJ)
        MTAB1.MTABTI(IJ) = CTYP
        MTAB1.MTABII(IJ) = IRET
        MTAB1.MTABTV(IJ) = mtable.MTABTI(IJ)
        IF (mtable.MTABTI(IJ).EQ.'FLOTTANT') THEN
          MTAB1.RMTABV(IJ) = mtable.RMTABI(IJ)
        ELSE
          MTAB1.MTABIV(IJ) = mtable.MTABII(IJ)
        ENDIF
      ENDDO
 
      SEGDES,MTABLE
      GOTO 900
 
 
C     Ecriture de l'objet TABLE resultat
 900  CONTINUE
      SEGDES,MTAB1
      CALL ECROBJ('TABLE   ',MTAB1)
 
c      RETURN
      END