Sources Esope | Cast3M

bjo4g
C BJO4G     SOURCE    CHAT      05/01/12    21:40:39     5004
      SUBROUTINE BJO4G(IGAU,XE,XEL,BPSS,SHPTOT,SHP,EPAIST,BGENE,DJAC
     .                                                         ,IRRT)
C=======================================================================
C
C     CALCUL DE LA MATRICE B = TETA * ( N , -N )
C     ET DU JACOBIEN EN IGAU
C          ROUTINE FORTRAN PUR
C          P. PEGON 2001 d'apres CODE S. FELIX MAI 92
C=======================================================================
C  INPUT
C     IGAU  = NUMERO DU POINT DE GAUSS
C     XEL   = COORDONNEES DES NOEUDS DE L'ELEMENT
C     BPSS  = MATRICE DE PASSAGE
C             BPSS(,) = AXE S1
C             BPSS(,) = AXE S2
C             BPSS(,) = AXE SN
C     SHPTOT= FONCTIONS DE FORME ET DERIVEES DANS L'ESPACE DE REFERENCE
C             SHPTOT(1, ) = FONCTION DE FORME
C             SHPTOT(2, ) = DERIVEES PAR RAPPORT A QSI
C             SHPTOT(3, ) = DERIVEES PAR RAPPORT A ETA
C  OUTPUT
C     SHP   = FONCTIONS DE FORME ET DERIVEES DANS L'ESPACE GEOMETRIQUE
C             SHP(1, ) = FONCTION DE FORME
C             SHP(2, ) = DERIVEES PAR RAPPORT A X LOCAL
C             SHP(3, ) = DERIVEES PAR RAPPORT A Y LOCAL
C     DJAC  = JACOBIEN AU POINT D'INTEGRATION IGAU
C     BGENE = MATRICE B AU POINT D'INTEGRATION IGAU
C     IRRT  = DIFFERENT DE ZERO SI ERREUR
C  CONSTANTES
C     NBNO  = NOMBRE DE NOEUDS
C     LRE   = NOMBRE DE COLONNES DE LA MATRICE B ("IDIM*NBNO")
C     NST   = NOMBRE DE COMPOSANTES DE CONTRAINTES
C
C  REMARQUE : ATTENTION : DANS LES CAS CONTRAINTES PLANES ET
C             AXISYMETRIQUE, LA MATRICE BPSS ( RESPECTIVEMENT BGENE )
C             N'A PLUS LA DIMENSION (3X3) ( RESPECTIVEMENT (3X24) ).
C             TROUVER LEURS DIMENSIONS CORRECTES ET MODIFIER LES
C             PARAMETRES LRE, NST, NBNO. CEUX CI CORRESPONDRONT A
C             CEUX DU CAS BIDIMENSIONNELS. AINSI PAR EXEMPLE, NBNO
C             SERA EGAL A 4, NST SERA EGAL A 2 ETC ...
C
C=======================================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      PARAMETER (LRE=24,NST=6,NBNO=8)
CcPPj DIMENSION XEL(3,*),BGENE(NST,*),SHP(6,*),SHPTOT(6,NBNO,*)
      DIMENSION XE(3,*),XEL(3,*),BGENE(NST,*),SHP(6,*),SHPTOT(6,NBNO,*)
      DIMENSION BPSS(3,3)
C
      IRRT = 0
C
C     MATRICE JACOBIENNE
C
      DO 1 I=1,NBNO
       SHP(1,I) = SHPTOT(1,I,IGAU)
       SHP(2,I) = SHPTOT(2,I,IGAU)
       SHP(3,I) = SHPTOT(3,I,IGAU)
    1 CONTINUE
C
      NBNONN=NBNO/2
      CALL JACOBI(XEL,SHP,2,NBNONN,DJAC)
      IF (DJAC.LT.0.0D0) THEN
         IRRT = 1
      ELSE IF (DJAC.EQ.0.0D0) THEN
         IRRT = 2
      ENDIF
C
C     MATRICE B ---> joint "standard"
C
      CALL ZERO(BGENE,NST,LRE)
      DO 2 I=1,3
       DO 3 J=1,4
        DO 4 K=1,3
         L=3*(J-1)+K
         M=L+12
         BGENE(I,L)=BPSS(I,K)*SHP(1,J)
         BGENE(I,M)=-BGENE(I,L)
    4   CONTINUE
    3  CONTINUE
    2 CONTINUE
CpPPj
C
C     DETERMINATION DE L'EPAISSEUR EN CAS DE BESOIN
C     (on utilise BGENE(3,.) pour l'ouverture)
C
      IF(EPAIST.EQ.0.D+0)THEN
        DO I=1,NBNO
          J=3*(I-1)
          DO K=1,3
            EPAIST=EPAIST+BGENE(3,J+K)*XE(K,I)
          ENDDO
        ENDDO
      ENDIF
      IF(EPAIST.LE.0.D+0)THEN
        IRRT = 10
      ENDIF
CpPPj
C
C     MATRICE B ---> complement pour le cisaillement
C
      DO I=1,2
        DO J=1,4
          DO K=1,3
            L=3*(J-1)+K
            M=L+12
            AAAA=0.5D0*BPSS(3,K)*SHP(I+1,J)*EPAIST
            BGENE(I,L)=BGENE(I,L)+AAAA
            BGENE(I,M)=BGENE(I,M)+AAAA
          ENDDO
        ENDDO
      ENDDO
C
C     MATRICE B ---> composante de deformation axiales dans le plan
C
      DO I=1,2
        DO J=1,4
          DO K=1,3
            L=3*(J-1)+K
            M=L+12
            BGENE(I+3,L)=0.5D0*BPSS(I,K)*SHP(I+1,J)
            BGENE(I+3,M)=BGENE(I+3,L)
          ENDDO
        ENDDO
      ENDDO
C
C     MATRICE B ---> composante de cisaillement (gamma) dans le plan
C
      DO J=1,4
        DO K=1,3
          L=3*(J-1)+K
          M=L+12
          BGENE(6,L)=0.5D0*BPSS(1,K)*SHP(2+1,J)
     >                +0.5D0*BPSS(2,K)*SHP(1+1,J)
          BGENE(6,M)=BGENE(6,L)
        ENDDO
      ENDDO
C
      RETURN
      END