Sources Esope | Cast3M

ella00
C ELLA00    SOURCE    CB215821  25/04/24    21:15:07     12248          
      SUBROUTINE ELLA00
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8     (A-H,O-Y)
      IMPLICIT COMPLEX*16 (Z)
C
C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                        A         11 27       04 4       90
C   OPERATEUR ELFE LAPLACE ACOU
C
C   CALCUL DES FONCTIONS DE TRANSFERT D'UN RESEAU DE TUYAUTERIES
C   CONTENANT UN FLUIDE SANS ECOULEMENT PAR LA METHODE DITE "INTEGRALE".
C   LA SYNTAXE EST LA SUIVANTE :
C
C   EVOL = ELFE LAPLACE POUTRE ACOU GEO1 (GEO2) CHP1 CHAM1 LFR S0 PT
C                                                       COMP IMETH (IMP)
C
C
C   ELFE .............. MOT DESIGNANT L'OPERATEUR
C
C   LAPLACE, ACOU ..... MOTS CLES POUR L'OPTION DE ELFE( CALCUL ACOUSTO-
C                                                      MECANIQUE)
C
C   GEO1 .............. OBJET TYPE MAILLAGE DONNANT LE RESEAU DE POUTRES
C
C   GEO2 (FACULTATIF).. OBJET TYPE MAILLAGE POUR L'OPTION DONNANT LE
C                      CHPOINT CONTENANT DEFORMATIONS ET PRESSIONS
C
C   CHP1 .............. OBJET TYPE CHPOINT DONNANT LES COND. AUX LIMITES
C
C   CHAM1 ............. OBJET TYPE NOUVEAU CHAMELEM POUR LES CARACT.
C                                              DU MATERIAU ET DU FLUIDE
C
C   LFR ............... OBJET TYPE LISTREEL DEFINISSANT LES FREQUENCES
C
C   S0  ............... OBJET TYPE REEL POUR LA TRANSFORMEE DE LAPLACE
C
C   PT ................ OBJET TYPE POINT OU L'ON DESIRE LE DEPLACEMENT
C
C   COMP .............. OBJET TYPE CHAR*2 DESIGNANT 'UX','UY' OU 'UZ'
C                                                   'RX','RY' OU 'RZ'
C
C   IMETH ............. ENTIER : CHOIX DE LA METHODE DE RESOLUTION
C
C   IMP (FALCULTATIF).. ENTIER : &lt;>0 POUR IMPRESSION INTERMEDIAIRE
C
C
C   PARAMETRES :
C                       ('NEANT')
C
C   SORTIES :
C
C   EVOLUTION --------> SI ON DESIRE LA FONCTION DE TRANSFERT
C
C   CHAMPOINT --------> SI ON DESIRE LES VALEURS  -DES DEPLACEMENTS
C                                                 -DES PRESSIONS
C                     EN MODULE ET EN PHASE AUX DIFFERENTS NOEUDS.
C
C
C  *****************************************************
C  *                                                   *
C  *  Organigramme d'appel des diff{rentes SUBROUTINE  *
C  *                                                   *
C  *****************************************************
C
C
C     ELLA00 (INTERFACE ESOPE &lt;--> FORTRAN)
C       |
C       |
C       |-----> ELLA09 (CONVERSION DE UX , UY ... EN 1 , 2 , ...
C       |
C       |-----> ELLA08 (CONVERSION DE YOUN , NU ... EN 1 , 2 , ...)
C       |
C       |
C       |-----> ELLA11 (PROGRAMME PRINCIPAL FORTRAN)
C                 |
C                 |
C                 |-----> ELLA12 (REMPLISSAGE DE LA 2}ME PARTIE DE ZA1
C                 |               qui ne d{pend pas de w)
C                 |
C                 |-----> ELLA21 (DETERMINATION, POUR CHAQUE POUTRE ET
C                           |     chaque frequence, de la matrice ZC1)
C                           |
C                           |
C                           |-----> ELLA31 (VALEUR DES FCTS DE GREEN)
C                           |
C                 |&lt;--------|
C                 |
C                 |
C                 |-----> ELLA51 (RESOLUTION DU SYSTEME LIN{AIRE)
C                 |      (ELLA53)
C                 |
C                 |
C       |&lt;--------|
C       |
C       |-----> ELLA23 (D{TERMINATION DES D{PLACEMENTS AUX NOEUDS DU
C       |               sous-maillage dans le cas du calcul de la
C       |               d{form{e )
C       |
C       |                -------------
C       |                |           |
C       |--------------->|    FIN    |
C                        |           |
C                        -------------
C
C   AUTEURS : SAINT-DIZIER ET GORCY
C   DATE    : 23 JANVIER 1991
C
C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
-INC CCREEL
-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
-INC SMELEME
-INC SMCHPOI
-INC SMCHAML
-INC SMLREEL
-INC SMEVOLL
 
        CHARACTER*(LOCOMP) COMP,CHAR
C
C ------------------- DIMENSIONNEMENT DES MATRICES CREEES LORS DE
C                     CETTE INTERFACE FORTRAN &lt;--> ESOPE
C
        SEGMENT MATRES
          COMPLEX*16 ZA1   (NP28,NP28)
          COMPLEX*16 ZSM   (NP28)
          COMPLEX*16 ZXX   (NP28)
          COMPLEX*16 ZSOL  (NNT14,NFRQ)
          REAL*8     COOR  (3 ,NP2)
          REAL*8     GAMA  (3 ,NP)
          REAL*8     CARACT(10,NP)
          REAL*8     XCL   (17 ,NNT)
          REAL*8     XCOR  (2 , 3 , NBELEM )
          REAL*8     VALDE1(2 , NBELEM , 3 )
          REAL*8     VALDE2(2 , NBELEM , 3 )
          REAL*8     VALDE3(2 , NBELEM , 1 )
          REAL*8     VALDE4(2 , NBELEM , 1 )
          INTEGER    FLAG  (NNT17)
          INTEGER    CORRES(NP2)
          INTEGER    NUMERO(NNT)
          INTEGER    MASS  (4,NNT)
          REAL*8     RMAS  (4,NNT)
          INTEGER    IRAILO(4,NNT)
          REAL*8     VALRAI(6,NNT)
          INTEGER    IPIVO(NP28)
          INTEGER    JPIVO(NP28)
          INTEGER    IAUX(NP28)
          INTEGER    IEXPER(NP)
          COMPLEX*16 ALPHAI(14,28,NP,NFRQ)
        ENDSEGMENT
C
C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C                 EXPLICATION DE CES VARIABLES
C                 ----------------------------
C
C  NP    :  NOMBRE TOTAL DE POUTRES DU MAILLAGE
C
C  NP2   :  NP * 2
C
C  NP10  :  NP * 10
C
C  NP28  :  NP * 28
C
C  NNT   :  NOMBRE TOTAL DE NOEUDS DU MAILLAGE
C
C  NNT14 :  NNT * 14
C
C  NNT17 :  NNT * 17
C
C  NFRQ  :  NOMBRE DE POINTS DE CALCUL EN FREQUENCE
C
C ---------------------------------------------------------------------
C
C .................... ZA1    : MATRICE DE RESOLUTION
C
C .................... ZSM    : VECTEUR SECOND MEMBRE
C
C .................... ZXX    : VECTEUR INCONNU
C
C   ZXX CONTIENT, POUR LES 2NP NOEUDS, DANS L'ORDRE SUIVANT :
C
C   UX   UY   UZ   RX   RY   RZ   FX   FY   FZ   MX   MY   MZ   P   Q
C
C
C .................... ZSOL   : TABLEAU SOLUTION POUR TOUTES LES FREQ.
C
C
C .................... COOR   : TABLEAU DES COORDONNEES
C
C  UNE POUTRE COMPORTE 2 NOEUDS  (P1 ET P2) -->  2*NP NOEUDS FICTIFS
C
C              | COOR(1,2*INP-1)             | COOR(1,2*INP)
C          P1  | COOR(2,2*INP-1)        P2   | COOR(2,2*INP)
C              | COOR(3,2*INP-1)             | COOR(3,2*INP)
C
C ---------------------------------------------------------------------
C
C .................... GAMA   : VECTEUR DEFINISSANT L'AXE OY
C                               POUR CHAQUE POUTRE
C
C
C .................... CARACT : TABLEAU DES CARACTERISTIQUES
C
C  CARACT EST UNE MATRICE (10,NP) QUI, POUR TOUTES LES NP POUTRES,
C  DONNE LES CARACTERISTIQUES GEOMETRIQUES ET PHYSIQUE DE LA POUTRE :
C
C  CARACT( 1,INP) --> MODULE D'YOUNG                     : E
C  CARACT( 2,INP) --> COEFICIENT DE POISSON              : NU
C  CARACT( 3,INP) --> MASSE VOLUMIQUE DU MATERIAU        : RHO
C  CARACT( 4,INP) --> RAYON INTERIEUR                    : RINT
C  CARACT( 5,INP) --> RAYON EXTERIEUR                    : REXT
C  CARACT( 6,INP) --> CONSTANTE DE TIMOSHENKO            : KCYZ
C  CARACT( 7,INP) --> COEFF. D'AMORTISSEMENT EXTERNE     : CAM
C  CARACT( 8,INP) --> COEFF. D'AMORTISSEMENT INTERNE     : ETA
C  CARACT( 9,INP) --> MASSE VOLUMIQUE DU FLUIDE          : RHOF
C  CARACT(10,INP) --> VITESSE DU SON                     : CSON
C
C ---------------------------------------------------------------------
C
C .................... XCL + FLAG : TABLEAU DONNANT LES CONDITIONS
C                                   AUX LIMITES POUR CHAQUE NOEUD.
C
C  XCL (K,NN) = VALEUR DE LA CONDITION K AU NOEUD REEL NN
C  LES CONDITIONS K CORRESPONDENT RESPECTIVEMENT A UX, UY, UZ, RX,
C  RY, RZ, FX, FY, FZ, MX, MY, MZ, DP, DQ, A, B, R
C                            ( IMPEDANCE ACOUSTIQUE: AP + BQ = R )
C
C     CHAQUE NOEUD AYANT SOIT LES DEPLACEMENTS, SOIT LES EFFORTS, SOIT
C  UNE SOURCE OU UNE IMPEDANCE ACOUSTIQUE, SOIT RIEN DU TOUTD'IMPOSE,
C  IL CONVIENT DE DEFINIR UN VECTEUR JOUANT LE ROLE DEPOINTEUR SUR
C  XCL QUE L'ON APPELLE FLAG DE LONGUEUR 17*NNT.
C
C     LES DIFFERENTS BLOCS DE 17 VALEURS POINTENT SUR LE NOEUD CORRES-
C  PONDANT :
C
C  LA VALEUR DE FLAG VAUT LE NUMERO DU NOEUD SI ON IMPOSE LA CONDITION
C  ELLE VAUT 0 SINON.
C
C ---------------------------------------------------------------------
C
C .................... CORRES : TABLEAU POUR CONNAITRE LES LIAISONS
C
C  CHAQUE NOEUD FICTIF EST ASSOCIE A UN NOEUD REEL ; LE TABLEAU CORRES
C  DONNE, POUR CHAQUE NOEUD FICTIF (2*NP), LE NUMERO DU NOEUD REEL AS-
C  SOCIE.
C
C ---------------------------------------------------------------------
C
C
C ....................  NUMERO   : TABLEAU DE NUMERO DE NOEUDS
C
C      NUMERO (I) = NUMERO GIBI DU IEME NOEUD ( 1 &lt; I &lt; N )
C
C  LA NUMEROTATION DE 1 A N EST ARBITRAIREMENT SELON LES NUMEROS
C  CROISSANTS DANS GIBI.
C
C
C ....................  MASS     : TABLEAU DONNANT POUR CHAQUE MASSE
C                                  PONCTUELLE :
C
C            - MASS(1,NNT) ... NUMERO DU NOEUD OU S'APPLIQUE LA MASSE
C            - MASS(2,NNT) ... NUMERO DE LA POUTREASSOCIEE
C            - MASS(3,NNT) ... NUMERO DU DEPLACEMENT UX CORRESPONDANT
C                              DANS LE VECTEUR DES INCONNUS
C            - MASS(4,NNT) ... NUMERO DE LIGNE DE LA COMPOSANTE FX DU
C                              NOEUD OU S'APPLIQUE LA MASSE
C
C ....................  RMAS     : TABLEAU DONNANT POUR LE NOEUD
C                                  CORRESPONDANT LA VALEUR DE LA MASSE
C                                                          DE J0X
C                                                          DE J0Y
C                                                          DE J0Z
C-----------------------------------------------------------------------
C
C......................  IRAILO : TABLEAU DONNANT POUR CHAQUE RAIDEUR
C                                 LOCALISEE
C
C             - IRAILO(1,NNT) ... NUMERO DU NOEUD OU S'APPLIQUE LA RAIDEUR
C             - IRAILO(2,NNT) ... NUMERO DE LA POUTRE ASSOCIEE
C             - IRAILO(3,NNT) ... NUMERO DU DEPLACEMENT UX CORRESPONDANT
C                                 DANS LE VECTEUR DES INCONNUES
C             - IRAILO(4,NNT) ... NUMERO DE LIGNE DE LA COMPOSANTE FX DU
C                                 NOEUD OU S'APPLIQUE LA RAIDEUR
C
C...................... VALRAI :  TABLEAU DONNANT LA VALEUR DES RAIDEURS
C                                 LOCALISEES
C
C             - VALRAI(1,NNT) ... KX
C             - VALRAI(2,NNT) ... KY
C             - VALRAI(3,NNT) ... KZ
C             - VALRAI(4,NNT) ... CX  RAISEUR EN TORSION
C             - VALRAI(5,NNT) ... CY  RAIDEUR EN FLEXION SUIVANT OY
C             - VALRAI(6,NNT) ... CZ  RAIDEUR EN FLEXION SUIVANT OZ
C
C ...........  IPIVO,JPIVO,IAUX  : TABLEAU INTERMEDIAIRE DE MEMORISATION
C                                  DE LA TRIANGULARISATION DE GAUSS
C
C
C .....................  VALDE1  : TABLEAU DONNANT POUR CHAQUE ELEMENT
C                                  DU SOUS MAILLAGE LE MODULE DU DEPLA-
C                                  CEMENT
C
C .....................  VALDE2  : TABLEAU DONNANT POUR CHAQUE ELEMENT
C                                  DU SOUS MAILLAGE LA PHASE DU DEPLA-
C                                  CEMENT
C
C
C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C ------------------- DIMENSIONNEMENT DES MATRICES AUXILIAIRES
C                     ----------------------------------------
C
        SEGMENT AUXI
          INTEGER IAUXI(NNNP)
        ENDSEGMENT
C
C -------------------- LECTURE DES OBJETS MAILLAGE CHPOINT ET LISTREEL
C                      -----------------------------------------------
C
        CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
        IF (IERR.NE.0) RETURN
C
        CALL LIROBJ('MAILLAGE',IPT4,0,IRETOU)
        IF (IERR.NE.0) RETURN
        IF (IRETOU.NE.0) THEN
          IDEPL = 1
          SEGACT IPT4
          NBELEM = IPT4.NUM(/2)
        ELSE
          IDEPL = 0
          NBELEM = 1
        END IF
C
        CALL LIROBJ('CHPOINT',MCHPO1,1,IRETOU)
        IF (IERR.NE.0) RETURN
C
        CALL LIROBJ('MCHAML',MCHEL1,1,IRETOU)
        IF (IERR.NE.0) RETURN
C
C     DECODAGE DE LA TABLE TEXP
C
      CALL LIRTAB('TAB_EXPERIMENTALE',ITEXP,0,IRETOU)
      IF (IERR.NE.0) RETURN
C
        CALL LIROBJ('LISTREEL',MLREE1,1,IRETOU)
        IF (IERR.NE.0) RETURN
C
        CALL LIRREE(S0,1,IRETOU)
        IF (IERR.NE.0) RETURN
C
        CALL LIROBJ('POINT',NPOI,1,IRETOU)
        IF (IERR.NE.0) RETURN
C
        CALL LIRCHA(CHAR,1,LCHAR)
        IF (IERR.NE.0) RETURN
C
        CALL ELLA09(CHAR,ICHAR,IERROR)
C
C
        METH= 2
C
        imp = 0
        IF (iimpi .eq. 333)  imp = ioimp
C
C
C -------------------- ACTIVATION DES SEGMENTS
C                      -----------------------
        SEGACT IPT1
        SEGACT MLREE1
        SEGACT MCHPO1
        SEGACT MCHEL1
C
C
C **********************************************************************
C                       LECTURE DU MAILLAGE
C **********************************************************************
C
C ..................NP : NOMBRE DE POUTRES DU MAILLAGE
C
        NP = IPT1.NUM(/2)
C
C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
C
        IF (IMP.NE.0) THEN
          WRITE (IMP,*) 'NOMBRE DE POUTRES DU MAILLAGE :',NP
        END IF
C
C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
C
        NN = IPT1.NUM(/1)
C
C --------------------- NFRQ : NOMBRE DE POINTS DE CALCUL EN FREQUENCE
C
        NFRQ = MLREE1.PROG(/1)
C
        IF (IDEPL.EQ.1.AND.NFRQ.NE.1) THEN
          RETURN
        END IF
C
C
C --------------------- DETERMINATION DU NOMBRE DE NOEUDS DU MAILLAGE
C                       ---------------------------------------------
        NNNP = NN*NP
        SEGINI AUXI
        ICOMP = 0
        DO 10 I = 1 , NP
            DO 11 J = 1 , NN
                AUXI.IAUXI(ICOMP+1) = IPT1.NUM(J,I)
C
                IF (ICOMP.LT.1) THEN
                    ITEST = 0
                    GOTO 13
                END IF
C
            ITEST = 0
            DO 12 K = 1 , ICOMP
                IF (AUXI.IAUXI(K).EQ.IPT1.NUM(J,I)) ITEST = 1
12          CONTINUE
C
13          IF (ITEST.EQ.0) ICOMP = ICOMP + 1
C
11          CONTINUE
C
10      CONTINUE
C
        SEGSUP AUXI
C
        NNT = ICOMP
C
C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
C
        IF (IMP.NE.0) THEN
          WRITE (IMP,*) 'NOMBRE TOTAL DE NOEUD DU MAILLAGE :',NNT
        END IF
C
C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
C
C --------------------- INITIALISATION DES TABLEAUX DE TRAVAIL
C                       --------------------------------------
        NP2   = NP  * 2
        NP10  = NP  * 10
        NP28  = NP  * 28
        NNT14 = NNT * 14
        NNT17 = NNT * 17
C
        SEGINI MATRES
C
        NUMP = 0
C
        DO 20 INP = 1 , NP
C
            IP1 = IPT1.NUM(1,INP)
C
C ----------------------  TRADUCTION NUMERO GLOBAL NUMERO LOCAL
C                         -------------------------------------
            IF (NUMP.EQ.0) THEN
              NUMP = NUMP + 1
              MATRES.NUMERO ( NUMP ) = IP1
                           ELSE
              NON = 0
              DO 21 I = 1 , NUMP
                  IF (MATRES.NUMERO(I).EQ.IP1) THEN
                    NON = 1
                  END IF
21            CONTINUE
C
              IF (NON.EQ.0) THEN
                NUMP = NUMP + 1
                MATRES.NUMERO ( NUMP ) = IP1
              END IF
            END IF
C
            IP2 = IPT1.NUM(2,INP)
C
C ----------------------  TRADUCTION NUMERO GLOBAL NUMERO LOCAL
C                         -------------------------------------
            NON = 0
            DO 22 I = 1 , NUMP
                IF (MATRES.NUMERO(I).EQ.IP2) THEN
                  NON = 1
                END IF
22          CONTINUE
C
            IF (NON.EQ.0) THEN
              NUMP = NUMP + 1
              MATRES.NUMERO ( NUMP ) = IP2
            END IF
C
C
C -------------------- COOR   : TABLEAU DES COORDONNEES
C                      --------------------------------
            MATRES.COOR(1,2*INP-1) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+1)
            MATRES.COOR(2,2*INP-1) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+2)
            MATRES.COOR(3,2*INP-1) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+3)
            MATRES.COOR(1,2*INP  ) = MCOORD.XCOOR((IP2-1)*(IDIM+1)+1)
            MATRES.COOR(2,2*INP  ) = MCOORD.XCOOR((IP2-1)*(IDIM+1)+2)
            MATRES.COOR(3,2*INP  ) = MCOORD.XCOOR((IP2-1)*(IDIM+1)+3)
C
C -------------------- CORRES : TABLEAU POUR CONNAITRE LES LIAISONS
C                      --------------------------------------------
C
            MATRES.CORRES(2*INP-1) = IP1
            MATRES.CORRES(2*INP  ) = IP2
C
20      CONTINUE
C
C
C **********************************************************************
C               LECTURE DU CHPOINT (CONDITIONS AUX LIMITES)
C **********************************************************************
C
C -------------------- XCL + FLAG : TABLEAU DONNANT LES CONDITIONS
C                      ----------   AUX LIMITES POUR CHAQUE NOEUD.
C
        NSOUPO = MCHPO1.IPCHP(/1)
C
        IMAS = 0
        IRAIDE = 0
C
        DO 26 I = 1 , NNT
          DO 25 J = 1 , 17
            MATRES.XCL(J,I) = 0.E0
            MATRES.FLAG((I-1)*17+J) = 0
25        CONTINUE
26      CONTINUE
C
        DO 30 I = 1 , NSOUPO
C
            MSOUP1 = MCHPO1.IPCHP(I)
            SEGACT MSOUP1
C
            IPT2 = MSOUP1.IGEOC
            SEGACT IPT2
C
            MPOVA2 = MSOUP1.IPOVAL
            SEGACT MPOVA2
C
            NC = MSOUP1.NOCOMP(/2)
            N  = MPOVA2.VPOCHA(/1)
C
            DO 31 J = 1 , N
C
C -- ON CHERCHE NUM(1,J) CAR DANS UN CHAMP PAR POINTS, LES
C -- ELEMENTS DES SOUS-MAILLAGES ELEMENTAIRES SONT LES POINTS
C -- DE CES SOUS-MAILLAGES, ET CHAQUE ELEMENT CONTIENT DONC UN
C -- SEUL NOEUD
C
              NOEUD = IPT2.NUM(1,J)
              ISTOP = 0
              ISTO1 = 0
C
              DO 33 K = 1 , NNT
                IF (MATRES.NUMERO(K).EQ.NOEUD) THEN
                  NNOEUD = K
                END IF
33            CONTINUE
C
              DO 32 K = 1 , NC
                COMP = MSOUP1.NOCOMP(K)
                CALL ELLA09(COMP,ICOMP,IERROR)
                IF (IERROR.NE.0) THEN
                  RETURN
                END IF
C
C     COMPTAGE DES MASSES
C
                IF (ICOMP.GE.18.AND.ISTOP.EQ.0.AND.ICOMP.LE.21) THEN
                  IMAS = IMAS + 1
                  ISTOP = 1
                END IF
C
C     COMPTAGE DES RAIDEURS
C
                IF (ICOMP.GE.22.AND.ISTO1.EQ.0.AND.ICOMP.LE.27) THEN
                  IRAIDE = IRAIDE + 1
                  ISTO1 = 1
                ENDIF
C
C     DETECTION DES MASSES ET AFFECTATION DES NUMEROS DE COLONNES
C
                IF (ICOMP.EQ.18) THEN
                  DO 35 II = 2*NP , 1 , -1
                    IF (CORRES(II).EQ.NOEUD) THEN
                      MATRES.MASS(1,IMAS) = II
                    END IF
   35             CONTINUE
C
                  MATRES.MASS(2,IMAS) = INT((MATRES.MASS(1,IMAS)+1)/2)
                  II = MATRES.MASS(1,IMAS)
                  JJ = INT(II/2)*2
                  IF (II.EQ.JJ) THEN
                    MATRES.MASS(3,IMAS) = 28*(MATRES.MASS(2,IMAS)-1)+15
                  ELSE
                    MATRES.MASS(3,IMAS) = 28*(MATRES.MASS(2,IMAS)-1)+1
                  END IF
C
                  MATRES.RMAS(1,IMAS) = MPOVA2.VPOCHA(J,K)
C
                ELSE IF (ICOMP.GT.18.AND.ICOMP.LE.21) THEN
                  JMAS = ICOMP - 17
                  MATRES.RMAS(JMAS,IMAS) = MPOVA2.VPOCHA(J,K)
C
                ELSE IF (ICOMP.LT.18 ) THEN
C
                  MATRES.XCL(ICOMP,NNOEUD)=MPOVA2.VPOCHA(J,K)
                  MATRES.FLAG((NNOEUD-1)*17+ICOMP)=NNOEUD
C
                END IF
C
C     DETECTION DES RAIDEURS ET AFFECTATION DES NUMEROS DE COLONNES
C
                IF (ICOMP.EQ.22) THEN
C
                  NUMFIC = 0
                  DO 60 II = 2*NP , 1 , -1
C
                    IF (CORRES(II).EQ.NOEUD) THEN
                      NUMFIC = NUMFIC + 1
C
                      IF (NUMFIC.GT.3) THEN
                      STOP
                      ENDIF
C
                      MATRES.IRAILO(NUMFIC,IRAIDE) = II
                    END IF
   60             CONTINUE
C
                  MATRES.IRAILO(4,IRAIDE)= NUMFIC
C
                  MATRES.VALRAI(1,IRAIDE) = MPOVA2.VPOCHA(J,K)
C
                ELSE IF (ICOMP.GT.22.AND.ICOMP.LE.27) THEN
                  JRAIDE = ICOMP - 21
C
                  MATRES.VALRAI(JRAIDE,IRAIDE) = MPOVA2.VPOCHA(J,K)
C
                ELSE IF (ICOMP.LT.18) THEN
C
                  MATRES.XCL(ICOMP,NNOEUD)=MPOVA2.VPOCHA(J,K)
                  MATRES.FLAG((NNOEUD-1)*17+ICOMP)=NNOEUD
C
                END IF
C
32            CONTINUE
31          CONTINUE
C
C
            SEGDES IPT2
            SEGDES MPOVA2
            SEGDES MSOUP1
C
30      CONTINUE
C
        NMAS = IMAS
        NRAIDE = IRAIDE
C
C **********************************************************************
C             LECTURE DU NOUVEAU CHAMLEM (CARACTERISTIQUES DU MATERIAU
C                                                         ET DU FLUIDE)
C **********************************************************************
C
C
      NELEXP=0
C
C .................... CARACT : TABLEAU DES CARACTERISTIQUES
C
      NN1 = MCHEL1.IMACHE(/1)
C
      DO 700 I = 1 , NN1
C
      IPT3   = MCHEL1.IMACHE(I)
      MCHAM1 = MCHEL1.ICHAML(I)
C
      SEGACT IPT3
      NBE = IPT3.NUM(/2)
C
      SEGACT MCHAM1
      NN2 = MCHAM1.IELVAL(/1)
      IF (NN2.EQ.1) THEN
C
C     IL Y A UN SEUL MOT CLEF : C'EST VECT
C     ON A UN ELEMENT EXPERIMENTAL
C
      CALL ELLA08(MCHAM1.NOMCHE(NN2),ICARAC,IERROR)
      IF (IERROR.NE.0) THEN
         RETURN
      END IF
C
      IF (ICARAC.NE.11) THEN
        RETURN
      END IF
C
      IF (NBE.GT.1) THEN
        RETURN
      END IF
C
      MELVA1 = MCHAM1.IELVAL(NN2)
      SEGACT MELVA1
      IPP = MELVA1.IELCHE(1,1)
      X1 = MCOORD.XCOOR((IPP-1)*(IDIM+1)+1)
      X2 = MCOORD.XCOOR((IPP-1)*(IDIM+1)+2)
      X3 = MCOORD.XCOOR((IPP-1)*(IDIM+1)+3)
      SEGDES MELVA1
C
      INU1 = IPT3.NUM(1,NBE)
      INU2 = IPT3.NUM(2,NBE)
      NCARAC = 0
      DO 720 III = 1 , NP2 , 2
      IN1 = MATRES.CORRES(III  )
      IN2 = MATRES.CORRES(III+1)
      IF (INU1.EQ.IN1.AND.INU2.EQ.IN2) THEN
      NCARAC = INT(III/2) + 1
      END IF
      IF (INU1.EQ.IN2.AND.INU2.EQ.IN1) THEN
      NCARAC = INT(III/2) + 1
      END IF
  720 CONTINUE
C
      NELEXP=NELEXP+1
      MATRES.IEXPER(NCARAC)=1
      MATRES.GAMA(1,NCARAC) = X1
      MATRES.GAMA(2,NCARAC) = X2
      MATRES.GAMA(3,NCARAC) = X3
C
C********************************
C
      ELSE
C
C     ON LIT LES CARACTERISTIQUES D'UNE POUTRE FORMULATION
C     INTEGRALE
C
      DO 713 II = 1,NN2
C
      CALL ELLA08(MCHAM1.NOMCHE(II),ICARAC,IERROR)
      IF (IERROR.NE.0) THEN
         RETURN
      END IF
C
            IF (ICARAC.NE.11) THEN
              MELVA1 = MCHAM1.IELVAL(II)
              SEGACT MELVA1
               XCARAC = MELVA1.VELCHE(1,1)
              SEGDES MELVA1
            ELSE
              MELVA1 = MCHAM1.IELVAL(II)
              SEGACT MELVA1
               IPP = MELVA1.IELCHE(1,1)
               X1 = MCOORD.XCOOR((IPP-1)*(IDIM+1)+1)
               X2 = MCOORD.XCOOR((IPP-1)*(IDIM+1)+2)
               X3 = MCOORD.XCOOR((IPP-1)*(IDIM+1)+3)
              SEGDES MELVA1
            END IF
C
            DO 716 IE = 1 , NBE
                INU1 = IPT3.NUM(1,IE)
                INU2 = IPT3.NUM(2,IE)
C
                NCARAC = 0
C
                DO 717 III = 1 , NP2 , 2
                    IN1 = MATRES.CORRES(III  )
                    IN2 = MATRES.CORRES(III+1)
                    IF (INU1.EQ.IN1.AND.INU2.EQ.IN2) THEN
                      NCARAC = INT(III/2) + 1
                    END IF
C
                    IF (INU1.EQ.IN2.AND.INU2.EQ.IN1) THEN
                      NCARAC = INT(III/2) + 1
                    END IF
C
  717         CONTINUE
C
                IF (ICARAC.NE.11) THEN
                  MATRES.CARACT(ICARAC,NCARAC) = XCARAC
                ELSE
                  MATRES.GAMA(1,NCARAC) = X1
                  MATRES.GAMA(2,NCARAC) = X2
                  MATRES.GAMA(3,NCARAC) = X3
                END IF
C
  716 CONTINUE
C
  713 CONTINUE
C
      END IF
C
      SEGDES MCHAM1
      SEGDES IPT3
C
  700 CONTINUE
C
C     LECTURE DE LA TABLE DES ELEMENTS EXPERIMENTAUX
C
      IF (NELEXP.GT.0) THEN
      CALL ELLA01(NELEXP,NP2,NFRQ,ITEXP,MATRES)
      END IF
C
C --------------------------  CALCUL DE LA VALEUR REEL DE NPOI
C                             --------------------------------
        DO 50 I = 1 , NNT
            IF (MATRES.NUMERO(I).EQ.NPOI) THEN
              NNPOI = I
            END IF
50      CONTINUE
C
        SEGDES IPT1
        SEGDES MCHPO1
        SEGDES MCHEL1
C
C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
C
      IF (IMP.NE.0) THEN
C
C ----------------------------------------------------------------------
C
C           IMPRESSION DES TABLEAUX CREES A L'INTERFACE
C
C     - COOR   ( 3 , 2*NP )
C     - CORRES ( 2*NP )
C     - GAMA   ( 3 , NP )
C     - CARACT (10 , NP )
C     - XCL    (17 , NNT )
C     - FLAG   ( 17*NNT )
C     - NUMERO ( NNT )
C     - MASS   ( 3 , NMAS )
C     - RMAS   ( 4 , NMAS )
C     - IRAILO ( 4 , NRAIDE )
C     - VALRAI ( 6 , NRAIDE )
C
C ----------------------------------------------------------------------
C
          WRITE (IMP,*) 'TABLEAU COOR :'
          WRITE (IMP,*) '************'
C
          DO 980 I = 1 , 2*NP
              WRITE (IMP,*) 'NOEUD ',I,':',
     *        MATRES.COOR(1,I),MATRES.COOR(2,I),MATRES.COOR(3,I)
980       CONTINUE
C
          WRITE (IMP,*) 'TABLEAU CORRES :'
          WRITE (IMP,*) '**************'
C
          DO 981 I = 1 , 2*NP
              WRITE (IMP,*) 'NOEUD ',I,':',MATRES.CORRES(I)
981       CONTINUE
C
C
          WRITE (IMP,*) 'TABLEAU NUMERO :'
          WRITE (IMP,*) '**************'
C
          DO 987 I = 1 , NNT
              WRITE (IMP,*) 'NOEUD ',I,':',MATRES.NUMERO(I)
987       CONTINUE
C
          WRITE (IMP,*) 'TABLEAU GAMA :'
          WRITE (IMP,*) '************'
C
          DO 982 I = 1 , NP
              WRITE (IMP,*) 'POUTRE ',I,':',
     *        MATRES.GAMA(1,I),MATRES.GAMA(2,I),MATRES.GAMA(3,I)
982       CONTINUE
C
          WRITE (IMP,*) 'TABLEAU CARACT :'
          WRITE (IMP,*) '**************'
C
          DO 983 I = 1 , NP
              WRITE (IMP,*) 'E    : ',MATRES.CARACT ( 1 , I)
              WRITE (IMP,*) 'NU   : ',MATRES.CARACT ( 2 , I)
              WRITE (IMP,*) 'RHO  : ',MATRES.CARACT ( 3 , I)
              WRITE (IMP,*) 'RINT : ',MATRES.CARACT ( 4 , I)
              WRITE (IMP,*) 'REXT : ',MATRES.CARACT ( 5 , I)
              WRITE (IMP,*) 'KCYZ : ',MATRES.CARACT ( 6 , I)
              WRITE (IMP,*) 'CAM  : ',MATRES.CARACT ( 7 , I)
              WRITE (IMP,*) 'ETA  : ',MATRES.CARACT ( 8 , I)
              WRITE (IMP,*) 'RHOF : ',MATRES.CARACT ( 9 , I)
              WRITE (IMP,*) 'CSON : ',MATRES.CARACT (10 , I)
983       CONTINUE
C
          WRITE (IMP,*) 'TABLEAU XCL :'
          WRITE (IMP,*) '***********'
C
          DO 984 I = 1 , 17
            DO 985 J = 1 , NNT
              WRITE (IMP,*) I , J,':',MATRES.XCL (I,J)
985         CONTINUE
984       CONTINUE
C
          WRITE (IMP,*) 'TABLEAU FLAG :'
          WRITE (IMP,*) '************'
C
          DO 986 I = 1 , 17*NNT
              WRITE (IMP,*) 'VAL ',I,':',MATRES.FLAG ( I )
986       CONTINUE
C
      WRITE(IMP,*) 'TABLEAU POUR LES MASSES :'
      WRITE(IMP,*) '***********************'
C
          WRITE(IMP,*)'NMAS : ',NMAS
C
          IF (NMAS.GT.0) THEN
C
            DO 988 I = 1 , NMAS
                WRITE (IMP,*) 'MASS (1,',I,') :',MATRES.MASS(1,I)
                WRITE (IMP,*) 'MASS (2,',I,') :',MATRES.MASS(2,I)
                WRITE (IMP,*) 'MASS (3,',I,') :',MATRES.MASS(3,I)
                WRITE (IMP,*) 'MASS (4,',I,') :',MATRES.MASS(4,I)
988         CONTINUE
C
            DO 989 I = 1 , NMAS
                WRITE (IMP,*) 'RMAS (1,',I,') :',MATRES.RMAS(1,I)
                WRITE (IMP,*) 'RMAS (2,',I,') :',MATRES.RMAS(2,I)
                WRITE (IMP,*) 'RMAS (3,',I,') :',MATRES.RMAS(3,I)
                WRITE (IMP,*) 'RMAS (4,',I,') :',MATRES.RMAS(4,I)
989         CONTINUE
          END IF
C
      WRITE(IMP,*) 'TABLEAU POUR LES RAIDEURS :'
      WRITE(IMP,*) '*************************'
C
          WRITE(IMP,*) 'NRAIDE : ',NRAIDE
C
          IF (NRAIDE.GT.0) THEN
            DO 800 I = 1 , NRAIDE
               WRITE(IMP,*) 'IRAILO(1,',I,') :',MATRES.IRAILO(1,I)
               WRITE(IMP,*) 'IRAILO(2,',I,') :',MATRES.IRAILO(2,I)
               WRITE(IMP,*) 'IRAILO(3,',I,') :',MATRES.IRAILO(3,I)
               WRITE(IMP,*) 'IRAILO(4,',I,') :',MATRES.IRAILO(4,I)
C
  800       CONTINUE
C
            DO 810 I = 1 , NRAIDE
               WRITE(IMP,*) 'VALRAI(1,',I,') :',MATRES.VALRAI(1,I)
               WRITE(IMP,*) 'VALRAI(2,',I,') :',MATRES.VALRAI(2,I)
               WRITE(IMP,*) 'VALRAI(3,',I,') :',MATRES.VALRAI(3,I)
               WRITE(IMP,*) 'VALRAI(4,',I,') :',MATRES.VALRAI(4,I)
               WRITE(IMP,*) 'VALRAI(5,',I,') :',MATRES.VALRAI(5,I)
               WRITE(IMP,*) 'VALRAI(6,',I,') :',MATRES.VALRAI(6,I)
C
  810       CONTINUE
          END IF
C
C           DO 820 I=1,NFRQ
C              WRITE(IMP,*) 'MLREE1.PROG(',I,')= ',MLREE1.PROG(I)
C 820       CONTINUE
C
C
          WRITE(IMP,*) 'NOMBRE D''ELEMENTS EXPERIMENTAUX NELEXP ',NELEXP
          DO 830 I=1,NP
             WRITE(IMP,*) 'IEXPER(',I,')= ',MATRES.IEXPER(I)
  830     CONTINUE
C
      DO 870 K=1,NP
C
      IF (MATRES.IEXPER(K).NE.0) THEN
        DO 840 L=1,NFRQ
          DO 850 I=1,14
            DO 860 J=1,28
C                WRITE(IMP,*) MATRES.ALPHAI(I,J,K,L)
                 IF (ABS(ALPHAI(I,J,K,L)).GE.1.0D-10) THEN
                 WRITE(IMP,871) I,J,K,L,MATRES.ALPHAI(I,J,K,L)
  871 FORMAT(1X,'ALPHAI(',I2,',',I2,',',I2,',',I2,')= ',2(1X,E12.5))
                 END IF
  860       CONTINUE
  850     CONTINUE
  840   CONTINUE
C
      END IF
  870 CONTINUE
C
      END IF
C
C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
C
C ----------------------------------------------------------------------
C
C      APPEL DU PROGRAMME FORTRAN POUR LA RESOLUTION DU PROBLEME
C
C     TABLEAUX D'ENTREE :
C
C      COOR(3,2*NP), CORRES(2*NP), GAMA(3,NP), CARACT(10,NP),
C      XCL(17,NNT) , FLAG (17*NNT), NUMERO (NNT) (NP NOMBRE DE POUTRES
C                                            NNT NOMBRE REEL DE NOEUDS)
C      IRAILO(4,NNT), VALRAI(6,NNT)
C
C     TABLEAUX DE SORTIE :
C
C     ZA1(28*NP,28*NP) , ZSM (28*NP) , ZXX (28*NP)
C
C ----------------------------------------------------------------------
C
        DO 141 I = 1 , NFRQ
           DO 142 J = 1 , NNT14
              MATRES.ZSOL(J,I) = CMPLX(0.D0,0.D0)
142        CONTINUE
141     CONTINUE
C
      CALL ELLA11(MATRES.COOR   , MATRES.CORRES  , MATRES.GAMA  ,
     *            MATRES.CARACT , MATRES.XCL     , MATRES.FLAG  ,
     *            MATRES.NUMERO , MATRES.ZA1     , MATRES.ZSM   ,
     *            MATRES.ZXX    , MATRES.ZSOL    , MATRES.MASS  ,
     *            MATRES.RMAS   , NMAS           , MATRES.IPIVO ,
     *            MATRES.JPIVO  , MATRES.IAUX    , MLREE1.PROG  ,
     &            MATRES.IRAILO , MATRES.VALRAI  , NRAIDE       ,
     &            MATRES.IEXPER , MATRES.ALPHAI ,NELEXP, NP , NP28 ,
     &            NNT   , NNT14 , NFRQ           ,
     &            S0    , XPI   , METH           , IMP)
C
         ZS = S0 + CMPLX(0.D0 , 1.D0 ) * 2. * XPI * MLREE1.PROG(1)
C
C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
        IF (IMP.NE.0) THEN
          WRITE (IMP,*)'VECTEUR SOLUTION ZSOL : ( PREMIERE FREQUENCE ) '
          DO 42 J = 1 , NNT14
                  WRITE (IMP,*) J,MATRES.ZSOL(J,1)
42        CONTINUE
C
        END IF
C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
C
        IF (IDEPL.EQ.0) THEN
C
         JG = NFRQ
         SEGINI MLREE2
         SEGINI MLREE3
C
         DO 100 I = 1 , NFRQ
C
             MLREE2.PROG(I) = ABS(MATRES.ZSOL((NNPOI-1)*14+ICHAR,I))
C
             ZT = MATRES.ZSOL((NNPOI-1)*14+ICHAR,I)
             PRZT = ZT
             PIZT = ZT*CMPLX(0.D0,-1.D0)
C
             IF (ABS(PRZT).LT.XPETIT.AND.ABS(PIZT).LT.XPETIT) THEN
               MLREE3.PROG(I) = 0.D0
             ELSE
               MLREE3.PROG(I) = ATAN2(PIZT,PRZT)*180.D0/XPI
             END IF
C
100      CONTINUE
C
C ------------------- OUVERTURE DU SEGMENT RESULTAT TYPE EVOLUTION
C                     --------------------------------------------
C
         N = 2
         SEGINI MEVOL1
         SEGINI KEVOL1
         SEGINI KEVOL2
C
         MEVOL1.ITYEVO = 'COMPLEXE'
C        MEVOL1.IEVTEX = 'OPERATEUR ELFE LAPLACE POUTRE'
         MEVOL1.IEVOLL(1) = KEVOL1
         MEVOL1.IEVOLL(2) = KEVOL2
C
C
         KEVOL1.IPROGX = MLREE1
         KEVOL1.IPROGY = MLREE2
         KEVOL1.NUMEVY = 'MODU'
         KEVOL1.TYPX   = 'LISTREEL'
         KEVOL1.TYPY   = 'LISTREEL'
         KEVOL1.NOMEVX = 'FREQ (HZ)'
         KEVOL1.NOMEVY = CHAR
C        KEVOL1.KEVTEX = '********'
C
C
         KEVOL2.IPROGX = MLREE1
         KEVOL2.IPROGY = MLREE3
         KEVOL2.NUMEVY = 'PHAS'
         KEVOL2.TYPX   = 'LISTREEL'
         KEVOL2.TYPY   = 'LISTREEL'
         KEVOL2.NOMEVX = 'FREQ (HZ)'
         KEVOL2.NOMEVY = CHAR
C        KEVOL2.KEVTEX = '********'
C
C
         CALL ECROBJ('EVOLUTION',MEVOL1)
C
         SEGDES KEVOL1
         SEGDES KEVOL2
         SEGDES MEVOL1
         SEGDES MLREE2
         SEGDES MLREE3
C
        ELSE
C
         DO 230 I = 1 , 2
           DO 240 J = 1 , NBELEM
             IP1 = IPT4.NUM(I,J)
             MATRES.XCOR(I,1,J) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+1)
             MATRES.XCOR(I,2,J) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+2)
             MATRES.XCOR(I,3,J) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+3)
240        CONTINUE
230      CONTINUE
C
         CALL ELLA23(MATRES.CARACT , MATRES.COOR    , MATRES.GAMA  ,
     *               MATRES.ZXX    , MATRES.XCOR    , MATRES.VALDE1,
     *               MATRES.VALDE2 , MATRES.VALDE3 , MATRES.VALDE4 ,
     *               ZS , NP , NBELEM , XPI )
C
         N1 = 1
         N2 = 8
         L1= 0
         N3= 0
         SEGINI MCHEL1
         SEGINI MCHAM1
         MCHEL1.IMACHE(1) = IPT4
         MCHEL1.ICHAML(1) = MCHAM1
C
         MCHAM1.NOMCHE(1) = 'UXM'
         MCHAM1.NOMCHE(2) = 'UYM'
         MCHAM1.NOMCHE(3) = 'UZM'
         MCHAM1.NOMCHE(4) = 'UXP'
         MCHAM1.NOMCHE(5) = 'UYP'
         MCHAM1.NOMCHE(6) = 'UZP'
         MCHAM1.NOMCHE(7) = 'PM'
         MCHAM1.NOMCHE(8) = 'PP'
         MCHAM1.TYPCHE(1) = 'REAL*8'
         MCHAM1.TYPCHE(2) = 'REAL*8'
         MCHAM1.TYPCHE(3) = 'REAL*8'
         MCHAM1.TYPCHE(4) = 'REAL*8'
         MCHAM1.TYPCHE(5) = 'REAL*8'
         MCHAM1.TYPCHE(6) = 'REAL*8'
         MCHAM1.TYPCHE(7) = 'REAL*8'
         MCHAM1.TYPCHE(8) = 'REAL*8'
C
         N1PTEL = 2
         N1EL = NBELEM
         N2PTEL = 0
         N2EL = 0
C
         SEGINI MELVA1
         SEGINI MELVA2
         SEGINI MELVA3
         SEGINI MELVA4
         SEGINI MELVA5
         SEGINI MELVA6
C
         MCHAM1.IELVAL(1) = MELVA1
         MCHAM1.IELVAL(2) = MELVA2
         MCHAM1.IELVAL(3) = MELVA3
         MCHAM1.IELVAL(4) = MELVA4
         MCHAM1.IELVAL(5) = MELVA5
         MCHAM1.IELVAL(6) = MELVA6
C
         DO  200 I = 1 , 2
           DO 210 J = 1 , NBELEM
             MELVA1.VELCHE(I,J) = VALDE1 ( I , J , 1 )
             MELVA2.VELCHE(I,J) = VALDE1 ( I , J , 2 )
             MELVA3.VELCHE(I,J) = VALDE1 ( I , J , 3 )
             MELVA4.VELCHE(I,J) = VALDE2 ( I , J , 1 )
             MELVA5.VELCHE(I,J) = VALDE2 ( I , J , 2 )
             MELVA6.VELCHE(I,J) = VALDE2 ( I , J , 3 )
210        CONTINUE
200      CONTINUE
C
C       MCHAM1.IELVAL(7) = MELVA1
C       MCHAM1.IELVAL(8) = MELVA2
C
C       DO 300 I = 1 , 2
C         DO 310 J = 1 , NBELEM
C           MELVA1.VELCHE(I,J) = VALDE3 ( I , J , 1 )
C           MELVA2.VELCHE(I,J) = VALDE4 ( I , J , 1 )
C310      CONTINUE
C300    CONTINUE
C
*         NSOUPO = 1
*         NAT=1
*         SEGINI MCHPO1
         CALL CHAMPO(MCHEL1,1,MCHPO1,IRET)
         CALL ECROBJ('CHPOINT',MCHPO1)
C
         SEGDES MELVA1
         SEGDES MELVA2
         SEGDES MELVA3
         SEGDES MELVA4
         SEGDES MELVA5
         SEGDES MELVA6
         SEGDES MCHAM1
         SEGDES MCHEL1
         SEGDES MCHPO1
C
C
        END IF
C
        SEGDES MLREE1
        SEGSUP MATRES
C
        END