Sources Esope | Cast3M

tseg2c
C TSEG2C    SOURCE    BP208322  15/06/22    21:23:28     8543
 
************************************************************************
*
*                             T S E G 2 C
*                             -----------
*
* FONCTION:
* ---------
*     CALCUL DE LA MATRICE DE CONDUCTIVITE D'UNE BARRE ( SEG2 )
*
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE
* -----------
*     IPMAIL   (E)  NUMERO DU MAILLAGE ELEMENTAIRE CONSIDERE,DANS
*                  L'OBJET MODELE
*     IPCHEM  (E)  POINTEUR SUR LE CHAMELEM DE CARACTERISTIQUES
*     IPRIGI (E/S) POINTEUR SUR L'OBJET RESULTAT,DE TYPE RIGIDITE
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*     DENIS ROBERT, LE 16 NOVEMBRE 1988.
*     REPRIS PAR P. DOWLATYARI SEP. 90
************************************************************************
 
      SUBROUTINE TSEG2C (NEF,IPMAIL,IPINTE,IMATE,IVAMAT,NVAMAT,
     &                   IPMATR,NLIGR)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
-INC CCHAMP
 
-INC SMCHAML
-INC SMCOORD
-INC SMELEME
-INC SMINTE
-INC SMRIGID
 
      SEGMENT,MMAT1
         REAL*8 VALMAT(NMATR)
         REAL*8 CEL(NBNN,NBNN),XE(3,NBNN)
      ENDSEGMENT
*
      SEGMENT MPTVAL
        INTEGER IPOS(NS)    ,NSOF(NS)
        INTEGER      IVAL(NCOSOU)
        CHARACTER*16 TYVAL(NCOSOU)
      ENDSEGMENT
*
      PARAMETER (X1s2 = 0.5D0)
 
c*      IF (NEF.NE.46) CALL ERREUR(5)
 
      IF (IFOMOD.NE.-1.AND.IFOMOD.NE.2.and.ifomod.ne.0) THEN
         CALL ERREUR(19)
         RETURN
      ENDIF
      IF (IMATE.NE.1) THEN
        CALL ERREUR (251)
        RETURN
      ENDIF
*
*---  CARACTERISTIQUES GEOMETRIQUES DU MAILLAGE ELEMENTAIRE
      MELEME = IPMAIL
c*      SEGACT,MELEME
      NBNN   = NUM(/1)
      NBELEM = NUM(/2)
*
*---  CARACTERISTIQUES D'INTEGRATION DU BARR-SEG2
      MINTE = IPINTE
c*      SEGACT,MINTE
      NBPGAU = POIGAU(/1)
*
      XMATRI = IPMATR
c*      SEGACT,XMATRI*MOD
*
      MPTVAL = IVAMAT
*
      NMATR = NVAMAT
      SEGINI,MMAT1
*
*---  BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IPMAIL
*
      DO 10 iel = 1, NBELEM
 
         CALL DOXE(XCOOR,IDIM,NBNN,NUM,iel,XE)
*
*- Calcul de la longueur de la BARRE
        IF (IDIM.EQ.2) THEN
         D = (XE(1,2)-XE(1,1))**2 + (XE(2,2)-XE(2,1))**2
        ELSE
         D =   (XE(1,2)-XE(1,1))**2 + (XE(2,2)-XE(2,1))**2
     &       + (XE(3,2)-XE(3,1))**2
        ENDIF
        IF (D.LE.XPETIT) THEN
          INTERR(1) = iel
          CALL ERREUR(255)
          GOTO 999
        ENDIF
*- Jacobien (constant) le long de la BARRE
        D = X1s2 / SQRT(D)
 
        CALL ZERO(CEL,NBNN,NBNN)
*
*---     BOUCLE SUR LES POINTS DE GAUSS
*
        DO 20 iGau = 1, NBPGAU
*
*- Recuperation des conductivite et section en un point de la barre
*- NB : ces composantes sont obligatoires donc IVAL(i) n'est pas nul !
          DO i = 1, NMATR
c*          IF (IVAL(i).NE.0) THEN
              MELVAL = IVAL(i)
              ibmn = MIN(iel ,VELCHE(/2))
              igmn = MIN(igau,VELCHE(/1))
              VALMAT(i) = VELCHE(igmn,ibmn)
c*          ELSE
c*            VALMAT(i) = 0.
c*          ENDIF
          ENDDO
*
          SE = VALMAT(2)
*- Section nulle ou trop faible dans une partie de l'element BARRE
          IF (SE.LE.XPETIT) THEN
            CALL ERREUR(517)
            GOTO 999
          ENDIF
*
* ON AJOUTE LE PRODUIT XK*SE*POIGAU*DETJ*B(TRANSPOSEE)*B
* POUR LE POINT DE GAUSS CONSIDERE A LA MATRICE CEL
          FAC = VALMAT(1) * SE * POIGAU(igau) * D
          CEL(1,1) = CEL(1,1) + FAC
          CEL(1,2) = CEL(1,2) - FAC
          CEL(2,1) = CEL(2,1) - FAC
          CEL(2,2) = CEL(2,2) + FAC
*
 20     CONTINUE
*
*- REMPLISSAGE DE XMATRI
        CALL REMPMT(CEL,NLIGR,RE(1,1,iel))
*
 10   CONTINUE
*
 999  CONTINUE
      SEGSUP,MMAT1
*
      RETURN
      END