C MANUR3    SOURCE    BP208322  15/06/22    21:20:28     8543
      SUBROUTINE MANUR3 (IPELEM,IINCO,IDUAL,IPDESC)
************************************************************************
*
*                             M A N U R 3
*                             -----------
*
* FONCTION:
* ---------
*
*     CONSTRUCTION DU DESCRIPTEUR D'UN OBJET 'RIGIDITE' CREE
*     MANUELLEMENT.
*     L'UTILISATION DE CE SOUS-PROGRAMME N'EST PAS UNIVERSELLE.
*
* MODE D'APPEL:
* -------------
*
*     CALL MANUR3 (IPELEM,IINCO,IDUAL,IPDESC)
*
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE
* -----------
*
*     IPELEM  ENTIER    (E)  POINTEUR DE L'OBJET 'MAILLAGE' SUR LEQUEL
*                            VA S'APPUYER LA 'RIGIDITE'.
*     IINCO   SEGMENT   (E)  REGROUPEMENT DE POINTEURS SUR DES
*                            'LISTMOTS'.
*                            SOIT IL N'Y A QU'1 'LISTMOTS', QUI CONTIENT
*                            LES NOMS DES COMPOSANTES POUR UN NOEUD D'UN
*                            ELEMENT DE L'OBJET DE POINTEUR "IPELEM",
*                            SOIT IL Y A AUTANT DE 'LISTMOTS' QUE DE
*                            NOEUDS PAR ELEMENT ET LE N-IEME 'LISTMOTS'
*                            CONTIENT LES NOMS DES COMPOSANTES POUR LE
*                            N-IEME NOEUD D'UN ELEMENT.
*     IDUAL   SEGMENT   (E)  IDEM POUR LES DUALES
*     IPDESC  ENTIER    (S)  POINTEUR SUR LE SEGMENT DESCRIPTEUR DE
*                            L'OBJET 'RIGIDITE'.
*
* LEXIQUE: (ORDRE ALPHABETIQUE)
* --------
*
*     MTEM3   SEGMENT   REGROUPEMENT DE POINTEURS SUR DES 'LISTMOTS'.
*                       MEME ORGANISATION QUE "MTEMP3", MAIS LES
*                       'LISTMOTS' CONTIENNENT LES NOMS DES INCONNUES
*                       DUALES.
*     NBCOMP  ENTIER    NOMBRE DE COMPOSANTES POUR UN NOEUD D'ELEMENT.
*     NBLMOT  ENTIER    NOMBRE DE 'LISTMOTS' REFERENCES PAR "MTEMP3".
*     NBMOTT  ENTIER    NOMBRE TOTAL DE NOMS DE COMPOSANTES DONNES.
*
*     LES AUTRES VARIABLES IMPORTANTES SONT EXPLIQUEES DANS LES MODULES
*     INCLUS.
*
* SOUS-PROGRAMMES APPELES:
* ------------------------
*
*     ERREUR.
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     PASCAL MANIGOT     19 FEVRIER 1985
*
* LANGAGE:
* --------
*
*     ESOPE + FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS.
*
************************************************************************
*
      IMPLICIT INTEGER(I-N)

-INC PPARAM
-INC CCOPTIO
-INC CCHAMP
-INC SMELEME
-INC SMLMOTS
-INC SMRIGID
*
      SEGMENT /MTEMP3/ (ILMOTS(0)),MTEM3.MTEMP3
*
      LOGICAL BADNAM
*
*
*
*     -- VERIFICATION DES NOMS DE COMPOSANTES DONNES ET ENREGISTREMENT
*     DES COMPOSANTES DUALES --
*
      MTEMP3=IINCO
      SEGACT,MTEMP3
      NBLMOT = ILMOTS(/1)
*
*     ON N'A PAS DONNE LES NOMS DES DUALES
*     ON CHERCHE DANS NOMDD
*
      IF (IDUAL.EQ.0) THEN
         SEGINI,MTEM3=MTEMP3
*
         NBMOTT = 0
         DO 100 IB100=1,NBLMOT
*
            MLMOTS = ILMOTS(IB100)
            SEGACT,MLMOTS
            NBMOTS = MOTS(/2)
            NBMOTT = NBMOTT + NBMOTS
            SEGINI,MLMOT1=MLMOTS
            MTEM3.ILMOTS(IB100) = MLMOT1
*
            DO 110 IB110=1,NBMOTS
*
               BADNAM = .TRUE.
               DO 120 IB120=1,LNOMDD
                  IF (MOTS(IB110) .EQ. NOMDD(IB120) ) THEN
                     MLMOT1.MOTS(IB110) = NOMDU(IB120)
                     BADNAM = .FALSE.
*                    --> SORTIE DE BOUCLE N.120
                     GOTO 122
                  END IF
  120             CONTINUE
*              END DO
  122          CONTINUE
*
               IF (BADNAM) THEN
                  MOTERR(1:4) = MOTS(IB110)
                  NUMERR = 197
                  CALL ERREUR (NUMERR)
                  RETURN
               END IF
*
  110          CONTINUE
*           END DO
*
            SEGDES,MLMOTS
            SEGDES,MLMOT1
*
  100       CONTINUE
*        END DO
*
*     ON A DONNE LES NOMS DES DUALES
*     ON NE FAIT AUCUNE VERIF SUR LES NOMS
*
      ELSE

         MTEM3=IDUAL
         SEGACT MTEM3
*
         NBMOTT=0
         DO 200 IB200=1,NBLMOT
            MLMOTS = ILMOTS(IB200)
            SEGACT,MLMOTS
            MLMOT1 = MTEM3.ILMOTS(IB200)
            SEGACT MLMOT1
            NBMOTS = MOTS(/2)
            IF (NBMOTS.NE.MLMOT1.MOTS(/2)) THEN
                   CALL ERREUR(217)
                   RETURN
            ENDIF
            NBMOTT = NBMOTT + NBMOTS
            SEGDES MLMOTS
            SEGDES MLMOT1
  200    CONTINUE

      ENDIF
*
*     -- REMPLISSAGE DU DESCRIPTEUR DE L'OBJET "RIGIDITE" --
*
      MELEME = IPELEM
      SEGACT,MELEME
      NBNN = NUM(/1)
      SEGDES,MELEME
*
      IF (NBLMOT .EQ. 1) THEN
*
         NLIGRP= NBMOTT * NBNN
         NLIGRD=NBMOTT * NBNN
         SEGINI,DESCR
         MLMOTS = ILMOTS(1)
         SEGACT,MLMOTS
         MLMOT1 = MTEM3.ILMOTS(1)
         SEGACT,MLMOT1
         NBCOMP = NBMOTT
*
         DO 500 IB500=1,NBNN
            ICONST = (IB500 - 1) * NBCOMP
            DO 510 IB510=1,NBCOMP
               III = IB510 + ICONST
               NOELEP(III) = IB500
               NOELED(III) = IB500
               LISINC(III) = MOTS(IB510)
               LISDUA(III) = MLMOT1.MOTS(IB510)
  510          CONTINUE
*           END DO
  500       CONTINUE
*        END DO
*
         SEGDES,MLMOTS
*
      ELSE IF (NBLMOT .GT. 1) THEN
*
         IF (NBLMOT .NE. NBNN) THEN
            NUMERR = 198
            CALL ERREUR (NUMERR)
            RETURN
         END IF
*
         NLIGRP = NBMOTT
         NLIGRD=NBMOTT
         SEGINI,DESCR
*
         ICONST = 0
         DO 550 IB550=1,NBNN
*
            MLMOTS = ILMOTS(IB550)
            SEGACT,MLMOTS
            MLMOT1 = MTEM3.ILMOTS(IB550)
            SEGACT,MLMOT1
            NBCOMP = MOTS(/2)
*
            DO 570 IB570=1,NBCOMP
               III = IB570 + ICONST
               NOELEP(III) = IB550
               NOELED(III) = IB550
               LISINC(III) = MOTS(IB570)
               LISDUA(III) = MLMOT1.MOTS(IB570)
  570          CONTINUE
*           END DO
*
            ICONST = ICONST + NBCOMP
*
            SEGDES,MLMOTS
*
  550       CONTINUE
*        END DO
*
      ELSE
*
*        IL N'A PAS ETE FOURNI DE 'LISTMOTS':
         MOTERR(1:8) = 'LISTMOTS'
         NUMERR = 37
         CALL ERREUR (NUMERR)
         RETURN
*
      END IF
*
      IPDESC = DESCR
      SEGDES,DESCR
      SEGDES,MTEMP3
      IF (IDUAL.EQ.0) THEN
         SEGSUP MTEM3
      ELSE
         SEGDES MTEM3
      ENDIF
*
      END