Sources Esope | Cast3M

coq4ri
C COQ4RI    SOURCE    CB215821  26/08/24    21:15:42     12622          
      SUBROUTINE COQ4RI (IGAU,BGENE,DJAC,EXCENT,NOPLAN,DHOOK,REL)
************************************************************************
*
*                             C O Q 4 R I
*                             -----------
*
* FONCTION:
* ---------
*
*     Calcul du produit Bt.D.B en 1 point de Gauss, pour le COQ4.
*
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
* -----------
*
*     IGAU    (E)  Num{ro du point de Gauss.
*     BGENE   (E)  Matrice "B".
*     DJAC    (E)  Jacobien.
*     EXCENT  (E)  Excentrement.
*     NOPLAN  (E)  = 1 si {l{ment non plan,
*                  = 0 sinon.
*     DHOOK   (E)  Matrice de Hooke int{gr{e dans l'{paisseur.
*                  S{paration par blocs:
*                  membrane, puis flexion, puis cisaillement transverse.
*             (S)  Contenu modifie.
*     REL     (E)  Matrice de Raideur.
*             (S)  Complet{e par la contribution du point de Gauss
*                  courant.
*
      IMPLICIT INTEGER(I-N)
      PARAMETER (NSTRS=8, LRE=24)
      REAL*8 DJAC,EXCENT
      REAL*8 DHOOK(NSTRS,NSTRS),REL(LRE,LRE),BGENE(NSTRS,LRE)
*
* VARIABLES:
* ----------
*
      REAL*8 DB(NSTRS,LRE)
*
* MODE DE FONCTIONNEMENT:
* -----------------------
*
*     Utilisation de la valeur de "Bm" au point central pour toute ou
*     partie de la raideur de membrane:
*     - tout si {l{ment non plan,
*     - cisaillement sinon.
*
*     Utilisation de la valeur de "Bf" au point central pour la raideur
*     de couplage membrane/flexion due @ l'excentrement dans les memes
*     conditions que pour la membrane.
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     Pascal MANIGOT     27 Mars 1991
*
************************************************************************
*
      DO 241 J=1,NSTRS
         DO 100 I=1,NSTRS
            DHOOK(I,J) = DJAC * DHOOK(I,J)
 100        CONTINUE
  241 CONTINUE
*        END DO
*     END DO
*
      CALL ZERO (DB,NSTRS,LRE)
      IF (ABS(EXCENT) .GT. 1.D-30) THEN
         INCMAX = 5
      ELSE
         INCMAX = 2
      END IF
*
      DO 110 NOEUD=1,4
         N6 = 6 * (NOEUD - 1)
*
*                                                eD.Bm | eD.h.Bf
         DO 243 J=1,INCMAX
            DO 242 I=1,3
               DO 120 K=1,3
                  DB(I,J+N6) = DB(I,J+N6) + DHOOK(I,K)*BGENE(K,J+N6)
 120              CONTINUE
  242       CONTINUE
  243    CONTINUE
*              END DO
*           END DO
*        END DO
*
         IF (IGAU .LE. 4) THEN
            DO 160 J=3,5
*                                                e3/12.D.Bf
               DO 244 I=4,6
                  DO 140 K=4,6
                     DB(I,J+N6) = DB(I,J+N6) + DHOOK(I,K)*BGENE(K,J+N6)
 140                 CONTINUE
  244          CONTINUE
*                 END DO
*              END DO
*                                                5/6.eG.Bc
               DB(7,J+N6) = DB(7,J+N6) + DHOOK(7,7)*BGENE(7,J+N6)
               DB(8,J+N6) = DB(8,J+N6) + DHOOK(8,8)*BGENE(8,J+N6)
 160           CONTINUE
*           END DO
         END IF
*
  110    CONTINUE
*     END DO
*
      IF (IGAU .LE. 4) THEN
*        Int{gration exacte.
*
*        Rigidit{ de Flexion et Cisaillement transverse.
         DO 248 M=3,5
            DO 247 L=3,5
               DO 246 NOEUD = 1,4
                  L6 = 6 * (NOEUD - 1)
                  DO 245 NOEUD2 = 1,4
                     M6 = 6 * (NOEUD2 - 1)
                     DO 200 I=4,8
                        REL(L+L6,M+M6)
     &                  = REL(L+L6,M+M6) + BGENE(I,L+L6)*DB(I,M+M6)
 200                    CONTINUE
  245             CONTINUE
  246          CONTINUE
  247       CONTINUE
  248    CONTINUE
*                    END DO
*                 END DO
*              END DO
*           END DO
*        END DO
*
         IF (NOPLAN .EQ. 0) THEN
*           Int{gration exacte raideur de membrane et de couplage
*           membrane/flexion, sauf cisaillement:
            DO 251 M=1,INCMAX
               DO 250 L=1,INCMAX
                  DO 249 NOEUD = 1,4
                     L6 = 6 * (NOEUD - 1)
                     DO 220 NOEUD2 = 1,4
                        M6 = 6 * (NOEUD2 - 1)
                        REL(L+L6,M+M6) = REL(L+L6,M+M6)
     &                                 + BGENE(1,L+L6)*DB(1,M+M6)
     &                                 + BGENE(2,L+L6)*DB(2,M+M6)
 220                    CONTINUE
  249             CONTINUE
  250          CONTINUE
  251       CONTINUE
*                    END DO
*                 END DO
*              END DO
*           END DO
         END IF
*
      ELSE IF (IGAU .EQ. 5) THEN
*
*        Int{gration r{duite raideur de membrane et de couplage
*        membrane/flexion:
         IF (NOPLAN .EQ. 1) THEN
            I1 = 1
         ELSE
            I1 = 3
         END IF
         DO 255 M=1,INCMAX
            DO 254 L=1,INCMAX
               DO 253 NOEUD = 1,4
                  L6 = 6 * (NOEUD - 1)
                  DO 252 NOEUD2 = 1,4
                     M6 = 6 * (NOEUD2 - 1)
                     DO 240 I=I1,3
                        REL(L+L6,M+M6)
     &                  = REL(L+L6,M+M6) + BGENE(I,L+L6)*DB(I,M+M6)
 240                    CONTINUE
  252             CONTINUE
  253          CONTINUE
  254       CONTINUE
  255    CONTINUE
*                    END DO
*                 END DO
*              END DO
*           END DO
*        END DO
*
      END IF
*
      END