Esope source files

   1 : C TDIAG1    SOURCE    CHAT      09/10/09    21:25:16     6519           
   2 :       SUBROUTINE TDIAG1(NOMDU1,NOMPR1,IPTMAIL,IPCH1,IPRIGI)
   3 : C
   4 : C**********************************************************************
   5 : C
   6 : C     Subroutine appelée par TDIAG.
   7 : C     Création d'une matrice de couplage dans le cas où les 
   8 : C     supports des inconnues primales et duales sont identiques.
   9 : C
  10 : C  ENTREES :
  11 : C  --------
  12 : C
  13 : C  NOMDU1  :  Nom de l'inconnue duale.
  14 : C  NOMPR1  :  Nom de l'inconnue primale.
  15 : C  IPTMAIL :  Pointeur du maillage de connectivite
  16 : C  IPCH1   :  Pointeur sur le champ multiplicateur.
  17 : C
  18 : C  SORTIE :
  19 : C  -------
  20 : C
  21 : C  IPRIGI  :  Pointeur sur la matrice de couplage élémentaire.
  22 : C
  23 : C
  24 : C AUTEUR, DATE DE CREATION:
  25 : C -------------------------
  26 : C
  27 : C     Laurent DADA      décembre 1996
  28 : C
  29 : C AUTEUR, DATE DE MODIFICATION:
  30 : C -----------------------------
  31 : C
  32 : C     Alexandre BLEYER          Novembre 2002
  33 : C     Modifications : - creation des matrices elementaires simplifiee
  34 : C                     - utilisation d'un maillage de connectivite 
  35 : C                      ici S.P.G des inconnues (spg Primale=spg Duale)
  36 : C
  37 : C LANGAGE:
  38 : C --------
  39 : C
  40 : C     ESOPE + FORTRAN77
  41 : C
  42 : C**********************************************************************
  43 : C
  44 :       IMPLICIT INTEGER(I-N)
  45 :       IMPLICIT REAL*8 (A-H,O-Z)
  46 : C
  47 : -INC CCOPTIO
  48 : -INC CCGEOME
  49 : -INC SMCOORD
  50 : -INC SMCHPOI
  51 : -INC SMELEME
  52 :       POINTEUR IPTMAIL.MELEME,IPTC1.MELEME
  53 : -INC SMRIGID
  54 : C
  55 :       SEGMENT REDI
  56 :         INTEGER IPOS1(NNGOT)
  57 :       ENDSEGMENT
  58 : C
  59 :       CHARACTER*8 TYPE,NOMDU1,NOMPR1
  60 : C
  61 : C Récupération du pointeur des valeurs
  62 : C du champ multiplicateur.
  63 : C Remplissage du tableau de redirection
  64 : C
  65 :       NNGOT = XCOOR(/1)/(IDIM+1)
  66 :       SEGINI REDI
  67 : C
  68 :       MCHPOI = IPCH1
  69 :       SEGACT MCHPOI
  70 :       MSOUPO = IPCHP(1)
  71 :       SEGDES MCHPOI
  72 :       SEGACT MSOUPO
  73 :       IPTC1  = IGEOC
  74 :       MPOVAL = IPOVAL
  75 :       SEGACT MPOVAL
  76 :       SEGDES MSOUPO
  77 :       SEGACT IPTC1
  78 :       NBELC1 = IPTC1.NUM(/2)
  79 :       DO 100 I100=1,NBELC1
  80 :         IPOS1(IPTC1.NUM(1,I100)) = I100
  81 : 100    CONTINUE
  82 :       SEGDES IPTC1
  83 : C
  84 : C activation du SPG de l'inconnue duale
  85 : C
  86 :       SEGACT IPTMAIL
  87 :       IF (IPTMAIL.ITYPEL.NE.1) THEN
  87 :         CALL ERREUR(16)
  88 :         RETURN
  89 :       ENDIF
  90 :       NBEL1 = IPTMAIL.NUM(/2)
  91 : C
  92 : C Création de la RIGIDITE
  93 : C
  94 :       NRIGE  = 8
  95 :       NRIGEL = 1
  96 :       SEGINI MRIGID
  97 :       IPRIGI = MRIGID
  98 : C
  99 :       MTYMAT = 'RIGIDITE'
 100 :       IFORIG = IFOMOD
 101 :       ICHOLE = 0
 102 :       IMGEO1 = 0
 103 :       IMGEO2 = 0
 104 :       ISUPEQ = 0
 105 :       COERIG(1)   = 1.D0
 106 :       IRIGEL(1,1) = IPTMAIL
 107 :       IRIGEL(2,1) = 0
 108 :       IRIGEL(5,1) = NIFOUR
 109 :       IRIGEL(6,1) = 0
 110 :       IRIGEL(7,1) = 0
 111 :       IRIGEL(8,1) = 0
 112 : C
 113 : C Remplissage du descripteur de l'objet RIGIDITE
 114 : C
 115 :       NLIGRP = 1
 116 :       NLIGRD = 1
 117 :       SEGINI DESCR
 118 :       IRIGEL(3,1) = DESCR
 119 : C
 120 :         NOELEP(1) = 1
 121 :         LISINC(1) = NOMPR1
 122 :         NOELED(1) = 1
 123 :         LISDUA(1) = NOMDU1
 124 : C
 125 :       SEGDES DESCR
 126 : C
 127 :       NELRIG = NBEL1
 128 :       SEGINI xMATRI
 129 :       DO 30 I30=1,NBEL1
 130 : *        SEGINI XMATRI
 131 : *        IMATTT(I30) = XMATRI
 132 :         NUMPT1 = IPTMAIL.NUM(1,I30)
 133 :         IF (IPOS1(NUMPT1).NE.0) THEN
 134 :           XVALM1 = VPOCHA(IPOS1(NUMPT1),1)
 135 :         ELSE
 136 :           MOTERR(1:8)  = 'CHPO    '
 136 :           CALL ERREUR(708)
 137 :           RETURN
 138 :         ENDIF
 139 :         RE(1,1,i30) = XVALM1
 140 : *        SEGDES XMATRI
 141 : 30    CONTINUE
 142 : 
 143 :       IRIGEL(4,1) = xMATRI
 144 :       SEGDES xMATRI
 145 : C
 146 : C
 147 :       SEGDES IPTMAIL
 148 :       SEGDES MPOVAL
 149 :       SEGDES MRIGID
 150 :       SEGSUP REDI
 151 : C
 152 :       END
 153 :  
 154 :