C BGRCQ2 SOURCE PV 11/04/07 21:15:00 6935 SUBROUTINE BGRCQ2(BGR,DJAC,IGAU,IFOU,XEL,NN,T,P,IARR) C|=================================================================| C| CALCUL DE LA MATRICE BGR DES COQUES @ 2 NOEUDS | C| ROUTINE FORTRAN PUR | C| SUO X.Z. JANVIER 87 | C| | C|= ENTREES | C| IGAU=NUMERO DU POINT DE GAUSS | C| IFOU=IFOUR DE CCOPTIO | C| XEL=COORDONNEES LOCALE DE L'ELEMENT | C| NN=NUMERO DU MODE DE FOURIER | C| T(IGAU)=POSITION DU POINT DE GAUSS | C| P(IGAU)=POIDS DU POINT DE GAUSS | C|= SORTIE | C| BGR(9,8)=MATRICE BGR AU POINT DE GAUSSPOUR IFOU GT 0 | C| BGR(9,6)=MATRICE BGR AU POINT DE GAUSSPOUR IFOU LE 0 | C| DJAC=JACOBIEN AU POINT DE GAUSS=POIGAU*LONG/2 (*R(IGAU), SI | C| IFOU EST SUPERIEUR OU EGAL A ZERO) | C| IARR=0 SI OK 1 SI LONGUEUR ELEMENT NULLE | C| 2 SI R / D INFERIEUR A 10-3 | C| | C| CODE SUO X.Z. | C|=================================================================| IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) PARAMETER(XZER=0.D0,UNDE=.5D0,UN=1.D0,DEUX=2.D0,TRS=3.D0) PARAMETER(QUTR=4.D0,SIX=6.D0,DOUZ=12.D0) DIMENSION BGR(9,*),T(*),XEL(3,*),P(*) C C ---------------------------------INITIALISATION IARR=0 DJAC=XZER IF(IFOU.GT.0) THEN CALL ZERO(BGR,9,8) ELSE IF(IFOU.LE.0) THEN CALL ZERO(BGR,9,6) ENDIF C D=SQRT((XEL(1,2)-XEL(1,1))**2+(XEL(2,2)-XEL(2,1))**2) IF(D.EQ.0) THEN IARR=1 GOTO 4 ENDIF DD=UN/D RO=(XEL(1,1)+XEL(1,2))*UNDE SP=(XEL(1,2)-XEL(1,1))/D CP=(XEL(2,2)-XEL(2,1))/D SP2=SP*SP CP2=CP*CP SPCP=SP*CP C X FONCTION FORME NOEUD 2 RRRR RAYON C Y FONCTION FORME NOEUD 1 D LONGUEUR DD INVERSE LONGUEUR X=UNDE+UNDE*T(IGAU) Y=UNDE-UNDE*T(IGAU) RRRR=RO+UNDE*D*SP*T(IGAU) C --------------------------------- C C TEST D'ERREUR C IF(ABS(RRRR/D).LE.1.D-03.AND.IFOU.GE.0) THEN IARR=2 GOTO 4 ENDIF C C ======= CALCULS ====== C IF(IFOU.LT.0) THEN RRRR=1.0D0 ENDIF U=X/RRRR V=Y/RRRR C C AXISYMMETRIQUE DEORMATIONS PLANES CONTRAINTES PLANES C IF(IFOU.LE.0) THEN C C GRADIAN DUDS C BGR(1,1)=-SP*DD BGR(1,2)=-CP*DD BGR(1,4)=-BGR(1,1) BGR(1,5)=-BGR(1,2) C C GRADIAN DUDZ C AUX = SIX*X*Y*DD BGR(3,1)=-CP*AUX BGR(3,2)= SP*AUX BGR(3,3)=-(UN-TRS*X)*Y BGR(3,4)= CP*AUX BGR(3,5)=-SP*AUX BGR(3,6)=-(TRS*X-DEUX)*X C C GRADIAN DVD0 C BGR(5,1)= V*(SP2+CP2*Y*(UN+DEUX*X)) BGR(5,2)= SPCP*U*Y*T(IGAU) BGR(5,3)=-D*CP*X*Y*V BGR(5,4)= U*(SP2+CP2*X*(TRS-DEUX*X)) BGR(5,5)=-SPCP*U*Y*T(IGAU) BGR(5,6)= D*CP*X*Y*U C C GRADIAN DWDS C DO 999 I=1,6 BGR(7,I) = -BGR(3,I) 999 CONTINUE C ENDIF C C ===== CALCUL EN SERIS DE FOURIER ===== C ELSE IF(IFOU.GT.0) THEN AN=DBLE(NN) C C GRADIAN DUDS C BGR(1,1)=-SP*DD BGR(1,2)=-CP*DD BGR(1,5)=-BGR(1,1) BGR(1,6)=-BGR(1,2) C C GRADIAN DVD0 C BGR(5,1)= V*(SP2+CP2*Y*(UN+DEUX*X)) BGR(5,2)= SPCP*U*Y*T(IGAU) BGR(5,3)=-AN*V BGR(5,4)=-D*CP*X*Y*V BGR(5,5)= U*(SP2+CP2*X*(TRS-DEUX*X)) BGR(5,6)=-SPCP*Y*U*T(IGAU) BGR(5,7)=-AN*U BGR(5,8)= D*CP*X*Y*U C C GRADIAN DUD0 C BGR(2,1)= -SP*V*AN BGR(2,2)= -CP*V*AN BGR(2,3)= V*SP BGR(2,5)= -SP*U*AN BGR(2,6)= -CP*U*AN BGR(2,7)= U*SP C C GRADIAN DVDS C BGR(4,3)=DD BGR(4,7)=-DD C C GRADIAN DUDZ C AUX=SIX*Y*X*DD BGR(3,1)=-CP*AUX BGR(3,2)= SP*AUX BGR(3,4)=-(UN-TRS*X)*Y BGR(3,5)= CP*AUX BGR(3,6)=-SP*AUX BGR(3,8)=-(TRS*X-DEUX)*X C C GRADIAN DVDZ C AUX1=AN*Y*V*(UN+DEUX*X) AUX2=AN*X*U*(TRS-DEUX*X) BGR(6,1)=-CP*AUX1 BGR(6,2)= SP*AUX1 BGR(6,3)= V*CP BGR(6,4)= AN*D*X*Y*V BGR(6,5)=-CP*AUX2 BGR(6,6)= SP*AUX2 BGR(6,7)= U*CP BGR(6,8)=-AN*D*Y*X*U C C GRADIAN DWDS C DO 10 I=1,8 BGR(7,I)= -BGR(3,I) 10 CONTINUE C C GRADIAN DWD0 C DO 20 I=1,8 BGR(8,I)= -BGR(6,I) BGR(9,I)=XZER 20 CONTINUE DJAC=D*UNDE*P(IGAU)*RRRR ENDIF 4 CONTINUE RETURN END