1 : C BGFCQ2 SOURCE AM 10/09/20 21:15:00 6756 2 : SUBROUTINE BGFCQ2(B,NGRA,DJAC,IGAU,IFOU,XEL,NN,T,P,EXCEN,DIM3, 3 : . IARR,XDPGE,YDPGE) 4 : C================================================================== 5 : C CALCUL DE LA MATRICE B DES GRADIENTS DE FLEXION 6 : C DES COQUES @ 2 NOEUDS 7 : C================================================================== 8 : C ENTREES 9 : C IGAU=NUMERO DU POINT DE GAUSS 10 : C IFOU=IFOUR DE CCOPTIO 11 : C XEL=COORDONNEES LOCALE DE L'ELEMENT 12 : C NN=NUMERO DU MODE DE FOURIER 13 : C T(IGAU)=POSITION DU POINT DE GAUSS 14 : C P(IGAU)=POIDS DU POINT DE GAUSS 15 : C EXCEN = EXCENTREMENT 16 : C DIM3 = EPAISSEUR DANS L'AUTRE DIMENSION 17 : C XDPGE,YDPGE : COORDONNEE DU POINT AUTOUR DUQUEL 18 : C FAIT LE MOUVEMENT EN DEFO PLAN GENE 19 : C SORTIE 20 : C B(2,*)=MATRICE B AU POINT DE GAUSS 21 : C DJAC=JACOBIEN AU POINT DE GAUSS=POIGAU*LONG/2 (*R(IGAU), SI 22 : C IFOU EST SUPERIEUR OU EGAL A ZERO) 23 : C IARR=0 SI OK 1 SI LONGUEUR ELEMENT NULLE 24 : C 2 SI R / D INFERIEUR A 10-3 25 : C================================================================== 26 : IMPLICIT INTEGER(I-N) 27 : IMPLICIT REAL*8(A-H,O-Z) 28 : C Include contenant quelques constantes dont XPI, XZERO : 29 : -INC CCREEL 30 : PARAMETER(UNDE=.5D0,UN=1.D0,DEUX=2.D0,TRS=3.D0) 31 : PARAMETER(QUTR=4.D0,SIX=6.D0,DOUZ=12.D0) 32 : DIMENSION B(NGRA,*),T(*),XEL(3,*),P(*) 33 : C 34 : C ---------------------------------INITIALISATION 35 : IARR=0 36 : DJAC=XZERO 37 : IF(IFOU.GT.0) THEN 38 : LRE=8 38 : CALL ZERO(B,2,8) 39 : ELSE IF(IFOU.LE.0) THEN 40 : LRE=6 40 : CALL ZERO(B,2,6) 41 : ENDIF 42 : C 43 : D=SQRT((XEL(1,2)-XEL(1,1))**2+(XEL(2,2)-XEL(2,1))**2) 44 : IF(D.EQ.0) THEN 45 : IARR=1 46 : GOTO 4 47 : ENDIF 48 : DD=UN/D 49 : RO=(XEL(1,1)+XEL(1,2))*UNDE 50 : R1=(XEL(2,1)+XEL(2,2))*UNDE 51 : SP=(XEL(1,2)-XEL(1,1))/D 52 : CP=(XEL(2,2)-XEL(2,1))/D 53 : SP2=SP*SP 54 : CP2=CP*CP 55 : SPCP=SP*CP 56 : C X FONCTION FORME NOEUD 2 RRRR RAYON 57 : C Y FONCTION FORME NOEUD 1 D LONGUEUR DD INVERSE LONGUEUR 58 : X=UNDE+UNDE*T(IGAU) 59 : Y=UNDE-UNDE*T(IGAU) 60 : RRRR=RO+UNDE*D*SP*T(IGAU) 61 : C --------------------------------- 62 : C 63 : C TEST D'ERREUR 64 : C 65 : IF(IFOU.GE.0) THEN 66 : IF(ABS(RRRR/D).LE.1.D-03) THEN 67 : IARR=2 68 : GOTO 4 69 : ENDIF 70 : ENDIF 71 : C 72 : C ---------------------------------CALCULS 73 : C 74 : IF(IFOU.LT.0) RRRR =UN 75 : U=X/RRRR 76 : V=Y/RRRR 77 : C 78 : C AXISYMETRIQUE DEFORMATIONS PLANES CONTRAINTES PLANES 79 : C 80 : IF(IFOU.LE.0) THEN 81 : C 82 : C RT,S 83 : C 84 : AUX = SIX*T(IGAU)*DD*DD 85 : B(1,1)= CP*AUX 86 : B(1,2)=-SP*AUX 87 : B(1,3)=(QUTR-SIX*X)*DD 88 : B(1,4)=-B(1,1) 89 : B(1,5)=-B(1,2) 90 : B(1,6)=(DEUX-SIX*X)*DD 91 : C 92 : C FOURIER 93 : C 94 : ELSE IF(IFOU.GT.0) THEN 95 : AN=DBLE(NN) 96 : C 97 : C RT,S 98 : C 99 : AUX= SIX*T(IGAU)*DD*DD 100 : B(1,1)= CP*AUX 101 : B(1,2)=-SP*AUX 102 : B(1,4)=(QUTR-SIX*X)*DD 103 : B(1,5)=-B(1,1) 104 : B(1,6)=-B(1,2) 105 : B(1,8)=(DEUX-SIX*X)*DD 106 : C 107 : C RT,T 108 : C 109 : AUX1=DOUZ*U*Y*AN*DD 110 : AUX =-AUX1 111 : B(3,1)=-CP*AUX 112 : B(3,2)= SP*AUX 113 : B(3,3)= 0. 114 : B(3,4)= AN*V*(DEUX-SIX*X) 115 : AUX= AUX1 116 : B(3,5)=-CP*AUX 117 : B(3,6)= SP*AUX 118 : B(3,7)= 0. 119 : B(3,8)= AN*U*(SIX*X-QUTR) 120 : ENDIF 121 : IF(IFOU.EQ.0.OR.(IFOU.EQ.1.AND.NN.EQ.0)) THEN 122 : DJAC=D*UNDE*P(IGAU)*RRRR*2*XPI 123 : ELSEIF(IFOU.EQ.1.AND.NN.NE.0) THEN 124 : DJAC=D*UNDE*P(IGAU)*RRRR*XPI 125 : ELSE 126 : DJAC=D*UNDE*P(IGAU)*RRRR*DIM3 127 : ENDIF 128 : * 129 : 4 CONTINUE 130 : RETURN 131 : END 132 : 133 : 134 : 135 : 136 : 137 : 138 : 139 : 140 :
© Cast3M 2003 - All rights reserved.
Disclaimer