Télécharger la plaquette Cast3M


fr en

Télécharger tdiag1.eso

Retour à la liste

Numérotation des lignes : 

tdiag1

  1. C TDIAG1    SOURCE    FANDEUR   22/01/03    21:15:51     11237          
  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.  
  48. -INC PPARAM
  49. -INC CCOPTIO
  50. -INC CCGEOME
  51. -INC SMCOORD
  52. -INC SMCHPOI
  53. -INC SMELEME
  54.       POINTEUR IPTMAIL.MELEME,IPTC1.MELEME
  55. -INC SMRIGID
  56. C
  57.       SEGMENT REDI
  58.         INTEGER IPOS1(NNGOT)
  59.       ENDSEGMENT
  60. C
  61.       CHARACTER*8 TYPE,NOMDU1,NOMPR1
  62. C
  63. C Récupération du pointeur des valeurs
  64. C du champ multiplicateur.
  65. C Remplissage du tableau de redirection
  66. C
  67.       NNGOT = nbpts
  68.       SEGINI REDI
  69. C
  70.       MCHPOI = IPCH1
  71.       SEGACT MCHPOI
  72.       MSOUPO = IPCHP(1)
  73.       SEGDES MCHPOI
  74.       SEGACT MSOUPO
  75.       IPTC1  = IGEOC
  76.       MPOVAL = IPOVAL
  77.       SEGACT MPOVAL
  78.       SEGDES MSOUPO
  79.       SEGACT IPTC1
  80.       NBELC1 = IPTC1.NUM(/2)
  81.       DO 100 I100=1,NBELC1
  82.         IPOS1(IPTC1.NUM(1,I100)) = I100
  83. 100    CONTINUE
  84.       SEGDES IPTC1
  85. C
  86. C activation du SPG de l'inconnue duale
  87. C
  88.       SEGACT IPTMAIL
  89.       IF (IPTMAIL.ITYPEL.NE.1) THEN
  90.         CALL ERREUR(16)
  91.         RETURN
  92.       ENDIF
  93.       NBEL1 = IPTMAIL.NUM(/2)
  94. C
  95. C Création de la RIGIDITE
  96. C
  97.       NRIGE  = 8
  98.       NRIGEL = 1
  99.       SEGINI MRIGID
  100.       IPRIGI = MRIGID
  101. C
  102.       MTYMAT = 'RIGIDITE'
  103.       IFORIG = IFOUR
  104.       ICHOLE = 0
  105.       IMGEO1 = 0
  106.       IMGEO2 = 0
  107.       ISUPEQ = 0
  108.       COERIG(1)   = 1.D0
  109.       IRIGEL(1,1) = IPTMAIL
  110.       IRIGEL(2,1) = 0
  111.       IRIGEL(5,1) = NIFOUR
  112.       IRIGEL(6,1) = 0
  113.       IF (NOMPR1 .EQ. NOMDU1) THEN
  114.          IRIGEL(7,1) = 0
  115.       ELSE
  116.          IRIGEL(7,1) = 2
  117.       ENDIF
  118.       IRIGEL(8,1) = 0
  119. C
  120. C Remplissage du descripteur de l'objet RIGIDITE
  121. C
  122.       NLIGRP = 1
  123.       NLIGRD = 1
  124.       SEGINI DESCR
  125.       IRIGEL(3,1) = DESCR
  126. C
  127.         NOELEP(1) = 1
  128.         LISINC(1) = NOMPR1
  129.         NOELED(1) = 1
  130.         LISDUA(1) = NOMDU1
  131. C
  132.       SEGDES DESCR
  133. C
  134.       NELRIG = NBEL1
  135.       SEGINI xMATRI
  136.       DO 30 I30=1,NBEL1
  137. *        SEGINI XMATRI
  138. *        IMATTT(I30) = XMATRI
  139.         NUMPT1 = IPTMAIL.NUM(1,I30)
  140.         IF (IPOS1(NUMPT1).NE.0) THEN
  141.           XVALM1 = VPOCHA(IPOS1(NUMPT1),1)
  142.         ELSE
  143.           MOTERR(1:8)  = 'CHPO    '
  144.           CALL ERREUR(708)
  145.           RETURN
  146.         ENDIF
  147.         RE(1,1,i30) = XVALM1
  148. *        SEGDES XMATRI
  149. 30    CONTINUE
  150.  
  151.       IRIGEL(4,1) = xMATRI
  152.       SEGDES xMATRI
  153. C
  154. C
  155.       SEGDES IPTMAIL
  156.       SEGDES MPOVAL
  157.       SEGDES MRIGID
  158.       SEGSUP REDI
  159. C
  160.       END
  161.  
  162.  
  163.  
  164.  
  165.  
  166.  
  167.  
  168.  
  169.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales