C TDIAG     SOURCE    CHAT      09/10/09    21:25:19     6519           
      SUBROUTINE TDIAG (IPTAB1)
C
C***********************************************************************
C
C
C FONCTION:
C ---------
C
C     Discrétisation de l'opération IDENTITE en "0D" sur des 
C     éléments de type POINT.
C
C
C ENTREE :
C ----------
C
C     IPTAB1          : TABLE de soustype 'OPER_0D' contenant les indices
C                       suivants :
C
C     TAB1 . 'MAILLAGE': maillage des connectivités entre le spg de 
C                        l'inc. primale et le spg de l'inc. duale
C                        (type MAILLAGE).
C     TAB1 . 'INCO'   : TABLE de soustype 'INCO' contenant l'ensemble
C                       des champs à l'itération précédant l'itération
C                       courante (type ENTIER).
C     TAB1 . 'COEF'   : Valeurs de la diagonale ou des coefficients de 
C                       couplage (type CHPOINT ou MOT).
C     TAB1 . 'PRIMAL' : Nom de l'inconnue primale (doit être un indice
C                       de la table de soustype 'INCO' (type MOT).
C     TAB1 . 'DUAL'   : Nom de l'inconnue duale (doit être un indice de
C                       la table de soustype 'INCO') (type MOT).
C     TAB1 . 'TYPEL'  : Mot indiquant quel type de spg on a entre l'inc.
C                       primale et l'inc. duale (type MOT).
C                       3 possibilités pour l'instant :
C                          - TAB1 . 'TYPEL' = 'P=D' (ou 'D=P')
C                            ==> spg primale = spg duale
C                          - TAB1 . 'TYPEL' = 'PD'
C                          - TAB1 . 'TYPEL' = 'DP'
C                       Selon que TAB1 . 'MAILLAGE' soit un maillage 
C                       entre Primale et Duale ou l'inverse
C
C  RESULTATS :
C  ----------
C
C     TAB1 . 'LHS' : Matrice élémentaire associée à l'opération
C                    (type RIGIDITE).
C
C REMARQUES:
C ----------
C
C      Si aucun nom de composante primale n'est donné le résultat est 
C      une matrice diagonale.
C      Si un nom de composante primale, différent du nom de la composante
C      duale, est donné, le résultat est une matrice de couplage.
C      Si les supports des composantes primales et duales sont différents
C      le résultat sera également une matrice de couplage.
C
C
C AUTEUR, DATE DE CREATION:
C -------------------------
C
C     Laurent DADA      décembre 1996
C
C AUTEUR, DATE DE MODIFICATION:
C -----------------------------
C
C     Alexandre BLEYER          Novembre 2002
C     Modifications : - creation des matrices elementaires simplifiee
C                     - utilisation d'un maillage de connectivite 
C                       entre l'inc. duale et l'inc. primale
C
C
C LANGAGE:
C --------
C
C     ESOPE + FORTRAN77
C
C***********************************************************************
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C
-INC CCOPTIO
-INC CCGEOME
-INC SMCOORD
-INC SMTABLE
      POINTEUR IPTAB1.MTABLE,IPTABI.MTABLE
-INC SMCHPOI
-INC SMELEME
      POINTEUR IPTMAIL.MELEME
-INC SMRIGID
C
      CHARACTER*8 TYPE,MOTI,MOT1,NOMPR1,NOMDU1,NOSUP1,NOSUD1,NOMMU1
      CHARACTER*8 TYPEL,MOTYP,TYPOBJ
      CHARACTER*4 NAMD1,NAMP1

C Recuperation du maillage des connectivite
      TYPOBJ='MAILLAGE'
      CALL ACMO (IPTAB1,'MAILLAGE',TYPOBJ,IPTMAIL)
      IF (IERR.NE.0) RETURN
C
C Lecture de la table INCO dans la table OPER_0D
C
      TYPE = 'TABLE   '
      CALL ACMO (IPTAB1,'INCO',TYPE,IPTABI)
      IF (IERR.NE.0) RETURN
C
      MOTI = 'SOUSTYPE'
      CALL ACMM (IPTABI,MOTI,MOT1)
      IF (IERR.NE.0) RETURN
      IF (MOT1(1:4).NE.'INCO') THEN
          MOTERR(1:8)  = 'INCO    '
          MOTERR(9:16) = 'INCO    '
          CALL ERREUR (790)
          RETURN
      ENDIF
C
C Récupération du CHPOINT multiplicateur
C
      TYPE = '        '
      CALL ACMO (IPTAB1,'COEF',TYPE,IPR1)
      IF (IERR.NE.0) RETURN
      IF (TYPE.EQ.'MOT     ') THEN
          CALL ACMM (IPTAB1,'COEF',NOMMU1)
          IF (IERR.NE.0) RETURN
C récupération du CHPOINT multiplicateur dans la table INCO
          TYPE = 'CHPOINT '
          CALL ACMO (IPTABI,NOMMU1,TYPE,IPCH1)
          IF (IERR.NE.0) RETURN
      ELSEIF (TYPE.EQ.'CHPOINT ') THEN
          IPCH1 = IPR1
      ELSE
          MOTERR(1:8)  = 'COEF    '
          MOTERR(9:16) = TYPE
          CALL ERREUR (787)
          RETURN
      ENDIF
C
C Lecture de l'inconnue PRIMALE
C
      TYPE = '        '
      CALL ACMO (IPTAB1,'PRIMAL',TYPE,IPR1)
      IF (TYPE.EQ.'MOT     ') THEN
          CALL ACMM (IPTAB1,'PRIMAL',NOMPR1)
          IF (IERR.NE.0) RETURN
      ENDIF
C
C Lecture de l'inconnue DUALE
C
      TYPE = '        '
      CALL ACMO (IPTAB1,'DUAL',TYPE,IDU1)
      IF (TYPE.EQ.'MOT     ') THEN
          CALL ACMM (IPTAB1,'DUAL',NOMDU1)
          IF (IERR.NE.0) RETURN
      ENDIF
C
C Lecture de l'ordre PRIMAL/DUAL par rapport au
C maillage des connectivites
C
      TYPE = '        '
      CALL ACMO (IPTAB1,'TYPEL',TYPE,ITYPL1)
      IF (TYPE.EQ.'MOT     ') THEN
          CALL ACMM (IPTAB1,'TYPEL',TYPEL)
          IF (IERR.NE.0) RETURN
      ENDIF
C
C Suivant TYPEL, on construit les differentes matrices
C
      IF ((TYPEL.EQ.'P=D').OR.(TYPEL.EQ.'D=P')) THEN
          CALL TDIAG1(NOMDU1,NOMPR1,IPTMAIL,IPCH1,MRIGID)
          IF (IERR.NE.0) RETURN
      ELSEIF(TYPEL.EQ.'PD') THEN
          ITY1=1
          CALL TDIAG2(ITY1,NOMDU1,NOMPR1,IPTMAIL,IPCH1,MRIGID)
          IF (IERR.NE.0) RETURN
      ELSEIF(TYPEL.EQ.'DP') THEN
          ITY1=2
          CALL TDIAG2(ITY1,NOMDU1,NOMPR1,IPTMAIL,IPCH1,MRIGID)
          IF (IERR.NE.0) RETURN
      ELSE
          CALL ERREUR (19)
          RETURN
      ENDIF
C
C Ecriture du résultat - Remplissage de l'indice 'LHS'
C
      TYPE = 'RIGIDITE'
      CALL ECMO (IPTAB1,'LHS',TYPE,MRIGID)
      IF (IERR.NE.0) RETURN
C
      END