Télécharger la plaquette Cast3M


fr en

Télécharger tdiag2.eso

Retour à la liste

Numérotation des lignes : 

tdiag2

  1. C TDIAG2    SOURCE    FANDEUR   22/01/03    21:15:51     11237          
  2.       SUBROUTINE TDIAG2(ITY1,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  ITY1    :  Cas MAILLAGE SEG2 couple (Primal,Dual)
  14. C       = 1 si support inc P&D correspond au maillage de connectivite
  15. C       = 2 si support inc P&D dans l'ordre different du maillage de
  16. C           connectivite
  17. C  NOMDU1  :  Nom de l'inconnue duale.
  18. C  NOMPR1  :  Nom de l'inconnue primale.
  19. C  IPTMAIL :  Pointeur du maillage de connectivite
  20. C  IPCH1   :  Pointeur sur le champ multiplicateur.
  21. C
  22. C  SORTIE :
  23. C  -------
  24. C
  25. C  IPRIGI  :  Pointeur sur la matrice de couplage élémentaire.
  26. C
  27. C
  28. C AUTEUR, DATE DE CREATION:
  29. C -------------------------
  30. C
  31. C     Laurent DADA      décembre 1996
  32. C
  33. C AUTEUR, DATE DE MODIFICATION:
  34. C -----------------------------
  35. C
  36. C     Alexandre BLEYER          Novembre 2002
  37. C     Modifications : - creation des matrices elementaires simplifiee
  38. C                     - utilisation d'un maillage de connectivite
  39. C                       entre l'inc. duale et l'inc. primale
  40. C
  41. C LANGAGE:
  42. C --------
  43. C
  44. C     ESOPE + FORTRAN77
  45. C
  46. C**********************************************************************
  47. C
  48.       IMPLICIT INTEGER(I-N)
  49.       IMPLICIT REAL*8 (A-H,O-Z)
  50. C
  51.  
  52. -INC PPARAM
  53. -INC CCOPTIO
  54. -INC CCGEOME
  55. -INC SMCOORD
  56. -INC SMCHPOI
  57. -INC SMELEME
  58.       POINTEUR IPTMAIL.MELEME,IPTC1.MELEME
  59. -INC SMRIGID
  60. C
  61.       SEGMENT REDI
  62.         INTEGER IPOS1(NNGOT)
  63.       ENDSEGMENT
  64. C
  65.       CHARACTER*8 TYPE,NOMDU1,NOMPR1
  66.       LOGICAL LPRIMA,LDUA
  67. C
  68. C Récupération du pointeur des valeurs
  69. C du champ multiplicateur.
  70. C Remplissage du tableau de redirection
  71. C
  72.       NNGOT = nbpts
  73.       SEGINI REDI
  74. C
  75.       MCHPOI = IPCH1
  76.       SEGACT MCHPOI
  77.       MSOUPO = IPCHP(1)
  78.       SEGDES MCHPOI
  79.       SEGACT MSOUPO
  80.       IPTC1  = IGEOC
  81.       MPOVAL = IPOVAL
  82.       SEGACT MPOVAL
  83.       SEGDES MSOUPO
  84.       SEGACT IPTC1
  85.       IF (IPTC1.ITYPEL.NE.1)   CALL CHANGE (IPTC1,1)
  86.       NBELC1 = IPTC1.NUM(/2)
  87.       DO 100 I100=1,NBELC1
  88.         IPOS1(IPTC1.NUM(1,I100)) = I100
  89. 100    CONTINUE
  90. C
  91. C activation du SPG de l'inconnue duale
  92. C
  93.       SEGACT IPTMAIL
  94.       IF (IPTMAIL.ITYPEL.NE.2) THEN
  95.         CALL ERREUR(16)
  96.         RETURN
  97.       ENDIF
  98.       NBEL1 = IPTMAIL.NUM(/2)
  99. C
  100. C Voir si le support du champ multiplicateur est le support
  101. C de l'inconne duale ou le support de l'inconnue primale
  102. C
  103.       I11 = 0
  104.       I12 = 0
  105.       DO 10 I10=1,NBELC1
  106.         IF (IPTC1.NUM(1,I10).EQ.IPTMAIL.NUM(1,1)) I11 = 1
  107.         IF (IPTC1.NUM(1,I10).EQ.IPTMAIL.NUM(2,1)) I12 = 1
  108.  10   CONTINUE
  109.  
  110.       LPRIMA =.FALSE.
  111.       LDUA   =.FALSE.
  112.       IF ((I11.EQ.1).AND.(I12.EQ.0)) THEN
  113.          LPRIMA=.TRUE.
  114.       ELSEIF ((I11.EQ.0).AND.(I12.EQ.1)) THEN
  115.          LDUA=.TRUE.
  116.       ELSE
  117.         MOTERR(1:8)  = 'CHPO    '
  118.         CALL ERREUR (708)
  119.         RETURN
  120.       ENDIF
  121. C
  122.       SEGDES IPTC1
  123. C
  124. C Création de la RIGIDITE
  125. C
  126.       NRIGE  = 8
  127.       NRIGEL = 1
  128.       SEGINI MRIGID
  129.       IPRIGI = MRIGID
  130. C
  131.       MTYMAT = 'RIGIDITE'
  132.       IFORIG = IFOUR
  133.       ICHOLE = 0
  134.       IMGEO1 = 0
  135.       IMGEO2 = 0
  136.       ISUPEQ = 0
  137.       COERIG(1)   = 1.D0
  138.       IRIGEL(1,1) = IPTMAIL
  139.       IRIGEL(2,1) = 0
  140.       IRIGEL(5,1) = NIFOUR
  141.       IRIGEL(6,1) = 0
  142.       IRIGEL(7,1) = 2
  143.       IRIGEL(8,1) = 0
  144. C
  145. C Remplissage du descripteur de l'objet RIGIDITE
  146. C
  147.       NLIGRP = 1
  148.       NLIGRD = 1
  149.       SEGINI DESCR
  150.       IRIGEL(3,1) = DESCR
  151. C
  152.         IF (ITY1.EQ.1) THEN
  153.           NOELEP(1) = 1
  154.           NOELED(1) = 2
  155.         ELSEIF (ITY1.EQ.2) THEN
  156.           NOELEP(1) = 2
  157.           NOELED(1) = 1
  158.         ENDIF
  159.         LISINC(1) = NOMPR1
  160.         LISDUA(1) = NOMDU1
  161. C
  162.       SEGDES DESCR
  163. C
  164. C Remplissage des matrices elementaires
  165. C
  166.       NELRIG = NBEL1
  167.       SEGINI xMATRI
  168.       DO 30 I30=1,NBEL1
  169. *        SEGINI XMATRI
  170. *        IMATTT(I30) = XMATRI
  171.         IF (LPRIMA) NUMPT1 = IPTMAIL.NUM(1,I30)
  172.         IF (LDUA)   NUMPT1 = IPTMAIL.NUM(2,I30)
  173.         IF (IPOS1(NUMPT1).NE.0) THEN
  174.           XVALM1 = VPOCHA(IPOS1(NUMPT1),1)
  175.         ELSE
  176.           MOTERR(1:8)  = 'CHPO    '
  177.           CALL ERREUR(708)
  178.           RETURN
  179.         ENDIF
  180.         RE(1,1,i30) = XVALM1
  181. *        SEGDES XMATRI
  182. 30    CONTINUE
  183.  
  184.       IRIGEL(4,1) = xMATRI
  185.       xmatri.symre=2
  186.       SEGDES xMATRI
  187. C
  188.       SEGDES IPTMAIL
  189.       SEGDES MPOVAL
  190.       SEGDES MRIGID
  191.       SEGSUP REDI
  192. C
  193.       END
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  

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