Esope source files

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