C BCO2 SOURCE AM 19/04/30 21:15:00 10215 SUBROUTINE BCO2(IGAU,MFR,IFOU,NIFOU,XEL,BPSS,SHPTOT,SHP, . BGENE,DJAC,IRRT,IDIM,NBNO,NST,LRE) C======================================================================= C C CALCUL DE LA MATRICE B = TETA * ( N , -N ) C ET DU JACOBIEN EN IGAU C ROUTINE FORTRAN PUR C DERIVEE DE LA ROUTINE BJO4 PAR S. FELIX 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 NBNO = NOMBRE DE NOEUDS C NST = NOMBRE DE COMPOSANTES DE CONTRAINTES C LRE = NOMBRE DE COLONNES DE LA MATRICE B 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 (3X18) ). C TROUVER LEURS DIMENSIONS CORRECTES ET MODIFIER LES C PARAMETRES LRE, NST, NBNO. CEUX CI CORRESPONDRONT A C CEUX DU CAS BIDIMENSIONNELS. C C======================================================================= IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) PARAMETER (XZero=0.,XUn=1.) DIMENSION 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) 1 CONTINUE C C !!!!!! ATTENTION : IL FAUT CALCULER LE JACOBIEN AVEC NBNO=4 !!!!!! C IL NE FAUT SURTOUT PAS METTRE NBNO=4 CAR CA FAUSSE ALORS C LES RESULTATS ... NBNO DOIT ETRE EGAL A 4 CAR IL YA 4 NOEUDS C NBNONN=NBNO/2 CALL DEVOLU(XEL,SHP,MFR,NBNONN,IFOU,NIFOU,1,1.D0,RR,DJAC) DJac=XZero dJInv=XZero DO i=1,NBNONN DJac=DJac+SHP(2,i)*XEL(1,i) ENDDO IF (DJac.NE.XZero) dJInv=XUn/DJac DO i=1,NBNONN SHP(2,i)=SHP(2,i)*dJInv ENDDO IF (DJAC.LT.0.0D0) THEN IRRT = 1 ELSE IF (DJAC.EQ.0.0D0) THEN IRRT = 2 ELSE IF (DJAC.GT.0.0D0) THEN IRRT = 0 DJAC = 0.5 ENDIF C C MATRICE B C CALL ZERO(BGENE,NST,LRE) DO 2 I=1,IDIM DO 3 J=1,2 DO 4 K=1,IDIM ** AM 30/04/19 ** L=3*(J-1)+K ** M=L+6 L=IDIM*(J-1)+K M=L+2*IDIM BGENE(I,L)=BPSS(I,K)*SHP(1,J) BGENE(I,M)=-BGENE(I,L) 4 CONTINUE 3 CONTINUE 2 CONTINUE C RETURN END