1 : C BGRCQ2 SOURCE PV 11/04/07 21:15:00 6935 2 : SUBROUTINE BGRCQ2(BGR,DJAC,IGAU,IFOU,XEL,NN,T,P,IARR) 3 : C|=================================================================| 4 : C| CALCUL DE LA MATRICE BGR DES COQUES @ 2 NOEUDS | 5 : C| ROUTINE FORTRAN PUR | 6 : C| SUO X.Z. JANVIER 87 | 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|= SORTIE | 16 : C| BGR(9,8)=MATRICE BGR AU POINT DE GAUSSPOUR IFOU GT 0 | 17 : C| BGR(9,6)=MATRICE BGR AU POINT DE GAUSSPOUR IFOU LE 0 | 18 : C| DJAC=JACOBIEN AU POINT DE GAUSS=POIGAU*LONG/2 (*R(IGAU), SI | 19 : C| IFOU EST SUPERIEUR OU EGAL A ZERO) | 20 : C| IARR=0 SI OK 1 SI LONGUEUR ELEMENT NULLE | 21 : C| 2 SI R / D INFERIEUR A 10-3 | 22 : C| | 23 : C| CODE SUO X.Z. | 24 : C|=================================================================| 25 : IMPLICIT INTEGER(I-N) 26 : IMPLICIT REAL*8(A-H,O-Z) 27 : PARAMETER(XZER=0.D0,UNDE=.5D0,UN=1.D0,DEUX=2.D0,TRS=3.D0) 28 : PARAMETER(QUTR=4.D0,SIX=6.D0,DOUZ=12.D0) 29 : DIMENSION BGR(9,*),T(*),XEL(3,*),P(*) 30 : C 31 : C ---------------------------------INITIALISATION 32 : IARR=0 33 : DJAC=XZER 34 : IF(IFOU.GT.0) THEN 34 : CALL ZERO(BGR,9,8) 35 : ELSE IF(IFOU.LE.0) THEN 35 : CALL ZERO(BGR,9,6) 36 : ENDIF 37 : C 38 : D=SQRT((XEL(1,2)-XEL(1,1))**2+(XEL(2,2)-XEL(2,1))**2) 39 : IF(D.EQ.0) THEN 40 : IARR=1 41 : GOTO 4 42 : ENDIF 43 : DD=UN/D 44 : RO=(XEL(1,1)+XEL(1,2))*UNDE 45 : SP=(XEL(1,2)-XEL(1,1))/D 46 : CP=(XEL(2,2)-XEL(2,1))/D 47 : SP2=SP*SP 48 : CP2=CP*CP 49 : SPCP=SP*CP 50 : C X FONCTION FORME NOEUD 2 RRRR RAYON 51 : C Y FONCTION FORME NOEUD 1 D LONGUEUR DD INVERSE LONGUEUR 52 : X=UNDE+UNDE*T(IGAU) 53 : Y=UNDE-UNDE*T(IGAU) 54 : RRRR=RO+UNDE*D*SP*T(IGAU) 55 : C --------------------------------- 56 : C 57 : C TEST D'ERREUR 58 : C 59 : IF(ABS(RRRR/D).LE.1.D-03.AND.IFOU.GE.0) THEN 60 : IARR=2 61 : GOTO 4 62 : ENDIF 63 : C 64 : C ======= CALCULS ====== 65 : C 66 : IF(IFOU.LT.0) THEN 67 : RRRR=1.0D0 68 : ENDIF 69 : U=X/RRRR 70 : V=Y/RRRR 71 : C 72 : C AXISYMMETRIQUE DEORMATIONS PLANES CONTRAINTES PLANES 73 : C 74 : IF(IFOU.LE.0) THEN 75 : C 76 : C GRADIAN DUDS 77 : C 78 : BGR(1,1)=-SP*DD 79 : BGR(1,2)=-CP*DD 80 : BGR(1,4)=-BGR(1,1) 81 : BGR(1,5)=-BGR(1,2) 82 : C 83 : C GRADIAN DUDZ 84 : C 85 : AUX = SIX*X*Y*DD 86 : BGR(3,1)=-CP*AUX 87 : BGR(3,2)= SP*AUX 88 : BGR(3,3)=-(UN-TRS*X)*Y 89 : BGR(3,4)= CP*AUX 90 : BGR(3,5)=-SP*AUX 91 : BGR(3,6)=-(TRS*X-DEUX)*X 92 : C 93 : C GRADIAN DVD0 94 : C 95 : BGR(5,1)= V*(SP2+CP2*Y*(UN+DEUX*X)) 96 : BGR(5,2)= SPCP*U*Y*T(IGAU) 97 : BGR(5,3)=-D*CP*X*Y*V 98 : BGR(5,4)= U*(SP2+CP2*X*(TRS-DEUX*X)) 99 : BGR(5,5)=-SPCP*U*Y*T(IGAU) 100 : BGR(5,6)= D*CP*X*Y*U 101 : C 102 : C GRADIAN DWDS 103 : C 104 : DO 999 I=1,6 105 : BGR(7,I) = -BGR(3,I) 106 : 999 CONTINUE 107 : C ENDIF 108 : C 109 : C ===== CALCUL EN SERIS DE FOURIER ===== 110 : C 111 : ELSE IF(IFOU.GT.0) THEN 112 : AN=DBLE(NN) 113 : C 114 : C GRADIAN DUDS 115 : C 116 : BGR(1,1)=-SP*DD 117 : BGR(1,2)=-CP*DD 118 : BGR(1,5)=-BGR(1,1) 119 : BGR(1,6)=-BGR(1,2) 120 : C 121 : C GRADIAN DVD0 122 : C 123 : BGR(5,1)= V*(SP2+CP2*Y*(UN+DEUX*X)) 124 : BGR(5,2)= SPCP*U*Y*T(IGAU) 125 : BGR(5,3)=-AN*V 126 : BGR(5,4)=-D*CP*X*Y*V 127 : BGR(5,5)= U*(SP2+CP2*X*(TRS-DEUX*X)) 128 : BGR(5,6)=-SPCP*Y*U*T(IGAU) 129 : BGR(5,7)=-AN*U 130 : BGR(5,8)= D*CP*X*Y*U 131 : C 132 : C GRADIAN DUD0 133 : C 134 : BGR(2,1)= -SP*V*AN 135 : BGR(2,2)= -CP*V*AN 136 : BGR(2,3)= V*SP 137 : BGR(2,5)= -SP*U*AN 138 : BGR(2,6)= -CP*U*AN 139 : BGR(2,7)= U*SP 140 : C 141 : C GRADIAN DVDS 142 : C 143 : BGR(4,3)=DD 144 : BGR(4,7)=-DD 145 : C 146 : C GRADIAN DUDZ 147 : C 148 : AUX=SIX*Y*X*DD 149 : BGR(3,1)=-CP*AUX 150 : BGR(3,2)= SP*AUX 151 : BGR(3,4)=-(UN-TRS*X)*Y 152 : BGR(3,5)= CP*AUX 153 : BGR(3,6)=-SP*AUX 154 : BGR(3,8)=-(TRS*X-DEUX)*X 155 : C 156 : C GRADIAN DVDZ 157 : C 158 : AUX1=AN*Y*V*(UN+DEUX*X) 159 : AUX2=AN*X*U*(TRS-DEUX*X) 160 : BGR(6,1)=-CP*AUX1 161 : BGR(6,2)= SP*AUX1 162 : BGR(6,3)= V*CP 163 : BGR(6,4)= AN*D*X*Y*V 164 : BGR(6,5)=-CP*AUX2 165 : BGR(6,6)= SP*AUX2 166 : BGR(6,7)= U*CP 167 : BGR(6,8)=-AN*D*Y*X*U 168 : C 169 : C GRADIAN DWDS 170 : C 171 : DO 10 I=1,8 172 : BGR(7,I)= -BGR(3,I) 173 : 10 CONTINUE 174 : C 175 : C GRADIAN DWD0 176 : C 177 : DO 20 I=1,8 178 : BGR(8,I)= -BGR(6,I) 179 : BGR(9,I)=XZER 180 : 20 CONTINUE 181 : DJAC=D*UNDE*P(IGAU)*RRRR 182 : ENDIF 183 : 4 CONTINUE 184 : RETURN 185 : END 186 : 187 : 188 : 189 : 190 :
© Cast3M 2003 - All rights reserved.
Disclaimer