Esope source files

   1 : C ETG       SOURCE    CHAT      09/04/08    21:15:26     6355           
   2 :       SUBROUTINE ETG
   3 :       IMPLICIT INTEGER(I-N)
   4 : -INC CCOPTIO
   5 : -INC SMTABLE
   6 : -INC CCNOYAU
   7 : -INC CCASSIS      
   8 :       LOGICAL        IR1,IR2
   9 :       REAL*8         RR1
  10 :       CHARACTER*(8)  CTYP,ICHAT,TYPRET,TYPRE1
  11 :       CHARACTER*(72) LEMOT
  12 : *     Lecture du premier objet
  13 : *     ------------------------
  13 :       CALL MESLIR(-225)
  13 :       CALL QUETYP(CTYP,0,IRETOU)
  14 :       IF(IRETOU.EQ.0) THEN
  15 : *       Cet opérateur a encore besoin d'un opérande.
  15 :         CALL ERREUR (533)
  16 :         RETURN
  17 :       ENDIF
  17 :       CALL LIROBJ(CTYP,IP1,1,IRETOU)      
  18 :       IF(CTYP.EQ.'TABLE') THEN
  19 :           MTABLE = IP1
  19 :          CALL ACCTAB(MTABLE,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,
  20 :      >               'MOT',ID3,RR1,CTYP,IR1,ID2)
  21 :          IF (CTYP.NE.'ESCLAVE') THEN
  22 : *           Donnez une TABLE de sous-type %m1:8
  23 :             MOTERR(1:8)='ESCLAVE'
  23 :             CALL ERREUR(-173)
  24 : *           Le sous-type de la table est incorrect
  24 :             CALL ERREUR(648)
  25 :             RETURN
  26 :          ENDIF
  27 :          SEGACT MTABLE
  28 :          ML=MLOTAB
  29 : *        L'INDICE 1 EST LE SOUS TYPE
  30 :          IND=MTABII(2)
  31 :          CTYP=' '
  31 :          CALL ACCTAB(MTABLE,'ENTIER',IND,0.D0,' ',.TRUE.,0,
  32 :      >               CTYP,ID3,RR1,' ',IR1,ID1)
  33 :          IRETOU=ID1
  34 :          IF (CTYP.EQ.'MAILLAGE') THEN
  35 :             DO I=3,ML
  36 :                SEGACT MTABLE
  37 :                IND=MTABII(I)
  37 :                CALL ACCTAB(MTABLE,'ENTIER',IND,0.D0,' ',.TRUE.,0,
  38 :      >                     CTYP,ID3,RR1,' ',IR1,ID2)
  39 :                IF (IERR.NE.0) RETURN
  39 :                CALL FUSE(ID1,ID2,IRETOU,LTELQ)
  40 :                ID1=IRETOU
  41 :             ENDDO
  42 :             SEGDES MTABLE
  43 :             GOTO 100
  44 :          ELSEIF (CTYP.EQ.'MCHAML') THEN
  45 :             DO I=3,ML
  46 :                SEGACT MTABLE
  47 :                IND=MTABII(I)
  47 :                CALL ACCTAB(MTABLE,'ENTIER',IND,0.D0,' ',.TRUE.,0,
  48 :      >                     CTYP,ID3,RR1,' ',IR1,ID2)
  49 :                IF (IERR.NE.0) RETURN
  49 :                CALL FUSCHL(ID1,ID2,IRETOU)
  50 :                ID1=IRETOU
  51 :             ENDDO
  52 :             SEGDES MTABLE
  53 :             GOTO 100
  54 :          ELSEIF (CTYP.EQ.'CHPOINT ') THEN
  55 :             DO I=3,ML
  56 :                SEGACT MTABLE
  57 :                IND=MTABII(I)
  57 :                CALL ACCTAB(MTABLE,'ENTIER',IND,0.D0,' ',.TRUE.,0,
  58 :      >                     CTYP,ID3,RR1,' ',IR1,ID2)
  58 :                CALL FUCHPO(ID1,ID2,IRETOU)
  59 :                IF (IERR.NE.0) RETURN
  60 :                ID1=IRETOU
  61 :             ENDDO
  62 :             SEGDES MTABLE
  63 :             GOTO 100
  64 :          ELSEIF (CTYP.EQ.'RIGIDITE') THEN
  65 :             DO I=3,ML
  66 :                SEGACT MTABLE
  67 :                IND=MTABII(I)
  67 :                CALL ACCTAB(MTABLE,'ENTIER',IND,0.D0,' ',.TRUE.,0,
  68 :      >                     CTYP,ID3,RR1,' ',IR1,ID2)
  68 :                CALL FUSRIG(ID1,ID2,IRETOU)
  69 :                IF (IERR.NE.0) RETURN
  70 :                ID1=IRETOU
  71 :             ENDDO
  72 :             SEGDES MTABLE
  73 :             GOTO 100
  74 :          ELSEIF (CTYP.EQ.'MMODEL') THEN
  75 :             DO I=3,ML
  76 :                SEGACT MTABLE
  77 :                IND=MTABII(I)
  77 :                CALL ACCTAB(MTABLE,'ENTIER',IND,0.D0,' ',.TRUE.,0,
  78 :      >                     CTYP,ID3,RR1,' ',IR1,ID2)
  78 :                CALL FUSMOD(ID1,ID2,IRETOU)
  79 :                IF (IERR.NE.0) RETURN
  80 :                ID1=IRETOU
  81 :             ENDDO
  82 :             SEGDES MTABLE
  83 :             GOTO 100
  84 :          ELSE
  85 : *           Donnez une TABLE de sous-type %m1:8
  86 :             MOTERR(1:8)='MAILLAGE'
  86 :             CALL ERREUR(-173)
  87 : *           Le sous-type de la table est incorrect
  87 :             CALL ERREUR(648)
  88 :             RETURN
  89 :          ENDIF
  89 : 100      call ecrobj(ctyp,id1)
  90 :       ELSE 
  90 :         call refus
  91 :       ENDIF
  92 :       END
  93 :