Esope source files

   1 : C TSEG2C    SOURCE    CHAT      12/06/07    21:16:13     7389           
   2 : 
   3 : ************************************************************************
   4 : *
   5 : *                             T S E G 2 C
   6 : *                             -----------
   7 : *
   8 : * FONCTION:
   9 : * ---------
  10 : *     CALCUL DE LA MATRICE DE CONDUCTIVITE D'UNE BARRE ( SEG2 )
  11 : *
  12 : * PARAMETRES:   (E)=ENTREE   (S)=SORTIE
  13 : * -----------
  14 : *     IPMAIL   (E)  NUMERO DU MAILLAGE ELEMENTAIRE CONSIDERE,DANS
  15 : *                  L'OBJET MODELE
  16 : *     IPCHEM  (E)  POINTEUR SUR LE CHAMELEM DE CARACTERISTIQUES
  17 : *     IPRIGI (E/S) POINTEUR SUR L'OBJET RESULTAT,DE TYPE RIGIDITE
  18 : *
  19 : * AUTEUR, DATE DE CREATION:
  20 : * -------------------------
  21 : *     DENIS ROBERT, LE 16 NOVEMBRE 1988.
  22 : *     REPRIS PAR P. DOWLATYARI SEP. 90
  23 : ************************************************************************
  24 : 
  25 :       SUBROUTINE TSEG2C (NEF,IPMAIL,IPINTE,IMATE,IVAMAT,NVAMAT,
  26 :      &                   IPMATR,NLIGR)
  27 : 
  28 :       IMPLICIT INTEGER(I-N)
  29 :       IMPLICIT REAL*8(A-H,O-Z)
  30 : 
  31 : -INC CCOPTIO
  32 : -INC CCREEL
  33 : -INC CCHAMP
  34 : 
  35 : -INC SMCHAML
  36 : -INC SMCOORD
  37 : -INC SMELEME
  38 : -INC SMINTE
  39 : -INC SMRIGID
  40 : 
  41 :       SEGMENT,MMAT1
  42 :          REAL*8 VALMAT(NMATR)
  43 :          REAL*8 CEL(NBNN,NBNN),XE(3,NBNN)
  44 :       ENDSEGMENT
  45 : *
  46 :       SEGMENT MPTVAL
  47 :         INTEGER IPOS(NS)    ,NSOF(NS)
  48 :         INTEGER      IVAL(NCOSOU)
  49 :         CHARACTER*16 TYVAL(NCOSOU)
  50 :       ENDSEGMENT
  51 : *
  52 :       PARAMETER (X1s2 = 0.5D0)
  53 : 
  53 : c*      IF (NEF.NE.46) CALL ERREUR(5)
  54 : 
  55 :       IF (IFOMOD.NE.-1.AND.IFOMOD.NE.2.and.ifomod.ne.0) THEN
  55 :          CALL ERREUR(19)
  56 :          RETURN
  57 :       ENDIF
  58 :       IF (IMATE.NE.1) THEN
  58 :         CALL ERREUR (251)
  59 :         RETURN
  60 :       ENDIF
  61 : *
  62 : *---  CARACTERISTIQUES GEOMETRIQUES DU MAILLAGE ELEMENTAIRE
  63 :       MELEME = IPMAIL
  64 : c*      SEGACT,MELEME
  65 :       NBNN   = NUM(/1)
  66 :       NBELEM = NUM(/2)
  67 : *
  68 : *---  CARACTERISTIQUES D'INTEGRATION DU BARR-SEG2
  69 :       MINTE = IPINTE
  70 : c*      SEGACT,MINTE
  71 :       NBPGAU = POIGAU(/1)
  72 : *
  73 :       XMATRI = IPMATR
  74 : c*      SEGACT,XMATRI*MOD
  75 : *
  76 :       MPTVAL = IVAMAT
  77 : *
  78 :       NMATR = NVAMAT
  79 :       SEGINI,MMAT1
  80 : *
  81 : *---  BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IPMAIL
  82 : *
  83 :       DO 10 iel = 1, NBELEM
  84 : 
  84 :          CALL DOXE(XCOOR,IDIM,NBNN,NUM,iel,XE)
  85 : *
  86 : *- Calcul de la longueur de la BARRE
  87 :         IF (IDIM.EQ.2) THEN
  88 :          D = (XE(1,2)-XE(1,1))**2 + (XE(2,2)-XE(2,1))**2
  89 :         ELSE
  90 :          D =   (XE(1,2)-XE(1,1))**2 + (XE(2,2)-XE(2,1))**2
  91 :      &       + (XE(3,2)-XE(3,1))**2
  92 :         ENDIF
  93 :         IF (D.LE.XPETIT) THEN
  94 :           INTERR(1) = iel
  94 :           CALL ERREUR(255)
  95 :           GOTO 999
  96 :         ENDIF
  97 : *- Jacobien (constant) le long de la BARRE
  98 :         D = X1s2 / SQRT(D)
  99 :         
  99 :         CALL ZERO(CEL,NBNN,NBNN)
 100 : *
 101 : *---     BOUCLE SUR LES POINTS DE GAUSS
 102 : *
 103 :         DO 20 iGau = 1, NBPGAU
 104 : *
 105 : *- Recuperation des conductivite et section en un point de la barre
 106 : *- NB : ces composantes sont obligatoires donc IVAL(i) n'est pas nul !
 107 :           DO i = 1, NMATR
 108 : c*          IF (IVAL(i).NE.0) THEN
 109 :               MELVAL = IVAL(i)
 110 :               ibmn = MIN(iel ,VELCHE(/2))
 111 :               igmn = MIN(igau,VELCHE(/1))
 112 :               VALMAT(i) = VELCHE(igmn,ibmn)
 113 : c*          ELSE
 114 : c*            VALMAT(i) = 0.
 115 : c*          ENDIF
 116 :           ENDDO
 117 : *
 118 :           SE = VALMAT(2)
 119 : *- Section nulle ou trop faible dans une partie de l'element BARRE
 120 :           IF (SE.LE.XPETIT) THEN
 120 :             CALL ERREUR(517)
 121 :             GOTO 999
 122 :           ENDIF
 123 : *
 124 : * ON AJOUTE LE PRODUIT XK*SE*POIGAU*DETJ*B(TRANSPOSEE)*B
 125 : * POUR LE POINT DE GAUSS CONSIDERE A LA MATRICE CEL
 126 :           FAC = VALMAT(1) * SE * POIGAU(igau) * D
 127 :           CEL(1,1) = CEL(1,1) + FAC
 128 :           CEL(1,2) = CEL(1,2) - FAC
 129 :           CEL(2,1) = CEL(2,1) - FAC
 130 :           CEL(2,2) = CEL(2,2) + FAC
 131 : *
 132 :  20     CONTINUE
 133 : *
 134 : *- REMPLISSAGE DE XMATRI
 134 :         CALL REMPMT(CEL,NLIGR,RE(1,1,iel))
 135 : *
 136 :  10   CONTINUE
 137 : *
 138 :  999  CONTINUE
 139 :       SEGSUP,MMAT1
 140 : *
 141 :       RETURN
 142 :       END
 143 : 
 144 :  
 145 :