Sources Esope | Cast3M

coq4rj
C COQ4RJ    SOURCE    CB215821  26/08/24    21:15:42     12622          
      SUBROUTINE COQ4RJ (IGAU,BGENE,DJAC,EXCENT,NOPLAN,DHOOK,REL)
************************************************************************
*
*                             C O Q 4 R J
*                             -----------
*
* FONCTION:
* ---------
*
*     Calcul du produit Bt.D.B en 1 point de Gauss, pour le COQ4 non-isotrope.
*
* 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,
*     - rien sinon.
*
*     Utilisation de la valeur de "Bf" au point central pour la raideur
*     de couplage membrane/flexion due à l'excentrement dans les mêmes
*     conditions que pour la membrane.
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     Michel BULIK       26 Novembre 1996 d'après COQ4RI écrit par
*     Pascal MANIGOT     27 Mars 1991
*
************************************************************************
*
*
*     On multiplie les termes de la matrice de Hooke par le Jacobien,
*     elle est déja intégrée dans l'épaisseur ...
*
      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
*
*     Mise à 0 de DB, en cas de coque non excentrée INCMAX=2 permet
*     d'éviter pas mal de multiplications par 0 ...
*
      CALL ZERO (DB,NSTRS,LRE)
      IF (ABS(EXCENT) .GT. 1.D-30) THEN
         INCMAX = 5
      ELSE
         INCMAX = 2
      END IF
*
*     Calcul de DB ...
*
      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
*
*        Pour le calcul de la raideur et lorsque IGAU=5, seules les
*        lignes de 1 à 3 de la matrice B peuvent contenir des termes
*        non nuls, d'où cette condition :
*
         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
*
* ATTENTION !!! en orthotrope, cela n'est pas correct !!!!!!!!!!!!!!!!!!
* car les termes (7,8) et (8,7) de D sont en général non nuls ...
*
*              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)
*
               DO 245 I=7,8
                  DO 150 K=7,8
                     DB(I,J+N6) = DB(I,J+N6) + DHOOK(I,K)*BGENE(K,J+N6)
 150                 CONTINUE
  245          CONTINUE
*                 END DO
*              END DO
 
 160           CONTINUE
*           END DO
         END IF
*
  110    CONTINUE
*     END DO
*
*     Intégration elle-même ...
*
      IF (IGAU .LE. 4) THEN
*        Intégration exacte.
*
*        Rigidité de Flexion et Cisaillement transverse.
         DO 249 M=3,5
            DO 248 L=3,5
               DO 247 NOEUD = 1,4
                  L6 = 6 * (NOEUD - 1)
                  DO 246 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
  246             CONTINUE
  247          CONTINUE
  248       CONTINUE
  249    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, avec cisaillement:
            DO 252 M=1,INCMAX
               DO 251 L=1,INCMAX
                  DO 250 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)
     &                                 + BGENE(3,L+L6)*DB(3,M+M6)
 220                    CONTINUE
  250             CONTINUE
  251          CONTINUE
  252       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
 
         DO 256 M=1,INCMAX
            DO 255 L=1,INCMAX
               DO 254 NOEUD = 1,4
                  L6 = 6 * (NOEUD - 1)
                  DO 253 NOEUD2 = 1,4
                     M6 = 6 * (NOEUD2 - 1)
                     DO 240 I= 1,3
                        REL(L+L6,M+M6)
     &                  = REL(L+L6,M+M6) + BGENE(I,L+L6)*DB(I,M+M6)
 240                    CONTINUE
  253             CONTINUE
  254          CONTINUE
  255       CONTINUE
  256    CONTINUE
*                    END DO
*                 END DO
*              END DO
*           END DO
*        END DO
*
         END IF
 
      END IF
*
      END