1 : C HOOKAN SOURCE AM 11/05/03 21:16:35 6955 2 : SUBROUTINE HOOKAN(VALMAT,IB,IGAU,MFR,IFOU,KCAS,NBGMAT,NELMAT, 3 : + SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOOK, 4 : + MELE,COBMA,XMOB,IRET) 5 : C 6 : C---------------------------------------------------------------------- 7 : C 8 : C Calcul de la matrice de HOOKE dans le cas d'un 9 : C matériau anisotrope 10 : C 11 : C Entrees: 12 : C -------- 13 : C VALMAT tableau de materiau 14 : C IB numero de l'element 15 : C IGAU numero du point de Gauss 16 : C MFR numero de formulation 17 : C IFOU numero d'harmonique de Fourier 18 : C KCAS = 1 si on veut la matrice pour elle-meme 19 : C = 2 si on veut la matrice pour l'inverser ensuite 20 : C NBGMAT, NELMAT tailles des tableaux 21 : C SECT SECTION DE L'ELEMENT IB (<> 0 SI MFR.EQ.27) 22 : C LHOOK taille de la matrice de HOOKE 23 : C TXR,XLOC,XGLOB,D1HOOK,ROTHOO tableaux de travail 24 : C 25 : C Sorties: 26 : C -------- 27 : C DDHOOK matrice de HOOKE 28 : C IRET = 1 si option existante, 0 sinon 29 : C 30 : C--------------------------------------------------------------------- 31 : C 32 : IMPLICIT INTEGER(I-N) 33 : IMPLICIT REAL*8(A-H,O-Z) 34 : PARAMETER(UN=1.D0,DEUX=2.D0,UNDEMI=.5D0) 35 : CHARACTER*8 MATE 36 : C 37 : -INC CCHAMP 38 : -INC CCOPTIO 39 : C 40 : DIMENSION VALMAT(*) 41 : DIMENSION DDHOOK(LHOOK,*) 42 : DIMENSION COBMA(*),COBAUX(10) 43 : REAL*8 XLOC(IDIM,*),XGLOB(IDIM,*),TXR(IDIM,*) 44 : REAL*8 D1HOOK(LHOOK,*),ROTHOO(LHOOK,*) 45 : C 46 : C INITIALISATIONS 47 : C 48 : MATE='ANISOTRO' 48 : CALL ZERO(DDHOOK,LHOOK,LHOOK) 48 : CALL ZERO(D1HOOK,LHOOK,LHOOK) 48 : CALL ZERO(XGLOB,IDIM,IDIM) 48 : CALL ZERO(ROTHOO,LHOOK,LHOOK) 48 : CALL ZERO(COBMA,LHOOK,1) 48 : CALL ZERO(COBAUX,LHOOK,1) 49 : C 50 : C 51 : C JOINT UNIDIMENSIONNEL JOI1 52 : C 53 : IF (MFR.EQ.75) THEN 54 : IF(IDIM.EQ.3)THEN 55 : DDHOOK(1,1)=VALMAT(7) 56 : DDHOOK(2,1)=VALMAT(13) 57 : DDHOOK(1,2)=DDHOOK(2,1) 58 : DDHOOK(2,2)=VALMAT(8) 59 : DDHOOK(3,1)=VALMAT(14) 60 : DDHOOK(1,3)=DDHOOK(3,1) 61 : DDHOOK(3,2)=VALMAT(15) 62 : DDHOOK(2,3)=DDHOOK(3,2) 63 : DDHOOK(3,3)=VALMAT(9) 64 : DDHOOK(4,1)=VALMAT(16) 65 : DDHOOK(1,4)=DDHOOK(4,1) 66 : DDHOOK(4,2)=VALMAT(17) 67 : DDHOOK(2,4)=DDHOOK(4,2) 68 : DDHOOK(4,3)=VALMAT(18) 69 : DDHOOK(3,4)=DDHOOK(4,3) 70 : DDHOOK(4,4)=VALMAT(10) 71 : DDHOOK(5,1)=VALMAT(19) 72 : DDHOOK(1,5)=DDHOOK(5,1) 73 : DDHOOK(5,2)=VALMAT(20) 74 : DDHOOK(2,5)=DDHOOK(5,2) 75 : DDHOOK(5,3)=VALMAT(21) 76 : DDHOOK(3,5)=DDHOOK(5,3) 77 : DDHOOK(5,4)=VALMAT(22) 78 : DDHOOK(4,5)=DDHOOK(5,4) 79 : DDHOOK(5,5)=VALMAT(11) 80 : DDHOOK(6,1)=VALMAT(23) 81 : DDHOOK(1,6)=DDHOOK(6,1) 82 : DDHOOK(6,2)=VALMAT(24) 83 : DDHOOK(2,6)=DDHOOK(6,2) 84 : DDHOOK(6,3)=VALMAT(25) 85 : DDHOOK(3,6)=DDHOOK(6,3) 86 : DDHOOK(6,4)=VALMAT(26) 87 : DDHOOK(4,6)=DDHOOK(6,4) 88 : DDHOOK(6,5)=VALMAT(27) 89 : DDHOOK(5,6)=DDHOOK(6,5) 90 : DDHOOK(6,6)=VALMAT(12) 91 : ELSE IF(IDIM.EQ.2)THEN 92 : DDHOOK(1,1)=VALMAT(3) 93 : DDHOOK(2,1)=VALMAT(6) 94 : DDHOOK(1,2)=DDHOOK(2,1) 95 : DDHOOK(2,2)=VALMAT(4) 96 : DDHOOK(3,1)=VALMAT(7) 97 : DDHOOK(1,3)=DDHOOK(3,1) 98 : DDHOOK(3,2)=VALMAT(8) 99 : DDHOOK(2,3)=DDHOOK(3,2) 100 : DDHOOK(3,3)=VALMAT(5) 101 : ENDIF 102 : GO TO 2035 103 : ELSE 104 : IRET=0 105 : GO TO 2035 106 : ENDIF 107 : * 108 : IF ( (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33) .AND. 109 : & IGAU.LE.NBGMAT ) THEN 110 : C 111 : C Formulation massive 112 : C 113 : IF (MFR.EQ.1.OR.MFR.EQ.31) THEN 114 : C 115 : C contraintes planes et KCAS=1 116 : C 117 : IF(IFOU.EQ.-2.AND.KCAS.EQ.1)THEN 118 : D11=VALMAT(1) 119 : D21=VALMAT(2) 120 : D22=VALMAT(3) 121 : D31=VALMAT(9) 122 : D32=VALMAT(10) 123 : D33=VALMAT(11) 124 : IF (D33.EQ.0.D0) D33=D11*1.E-6 125 : D41=VALMAT(4) 126 : D42=VALMAT(5) 127 : D43=VALMAT(12) 128 : D44=VALMAT(6) 129 : D1HOOK(1,1)=D11 - ((D31**2)/D33) 130 : D1HOOK(2,1)=D21 - ((D31*D32)/D33) 131 : D1HOOK(1,2)=D1HOOK(2,1) 132 : D1HOOK(2,2)=D22 - ((D32**2)/D33) 133 : D1HOOK(4,1)=D41 - ((D31*D43)/D33) 134 : D1HOOK(1,4)=D1HOOK(4,1) 135 : D1HOOK(4,2)=D42 - ((D32*D43)/D33) 136 : D1HOOK(2,4)=D1HOOK(4,2) 137 : D1HOOK(4,4)=D44 - ((D43**2)/D33) 138 : C 139 : C contraintes planes et KCAS=2 140 : C 141 : ELSE IF(IFOU.EQ.-2.AND.KCAS.EQ.2)THEN 142 : D1HOOK(1,1)=VALMAT(1) 143 : D1HOOK(2,1)=VALMAT(2) 144 : D1HOOK(1,2)=D1HOOK(2,1) 145 : D1HOOK(2,2)=VALMAT(3) 146 : D1HOOK(4,1)=VALMAT(4) 147 : D1HOOK(1,4)=D1HOOK(4,1) 148 : D1HOOK(4,2)=VALMAT(5) 149 : D1HOOK(2,4)=D1HOOK(4,2) 150 : D1HOOK(4,4)=VALMAT(6) 151 : D1HOOK(3,3)=VALMAT(11) 152 : D1HOOK(3,1)=VALMAT(9) 153 : D1HOOK(1,3)=D1HOOK(3,1) 154 : D1HOOK(3,2)=VALMAT(10) 155 : D1HOOK(2,3)=D1HOOK(3,2) 156 : D1HOOK(4,3)=VALMAT(12) 157 : D1HOOK(3,4)=D1HOOK(4,3) 158 : C 159 : C deformations planes et axisymetrie 160 : C 161 : ELSEIF(IFOU.EQ.-1.OR.IFOU.EQ.0.OR.IFOU.EQ.-3) THEN 162 : D1HOOK(1,1)=VALMAT(1) 163 : D1HOOK(2,1)=VALMAT(2) 164 : D1HOOK(1,2)=D1HOOK(2,1) 165 : D1HOOK(2,2)=VALMAT(3) 166 : D1HOOK(3,1)=VALMAT(4) 167 : D1HOOK(1,3)=D1HOOK(3,1) 168 : D1HOOK(3,2)=VALMAT(5) 169 : D1HOOK(2,3)=D1HOOK(3,2) 170 : D1HOOK(3,3)=VALMAT(6) 171 : D1HOOK(4,1)=VALMAT(7) 172 : D1HOOK(1,4)=D1HOOK(4,1) 173 : D1HOOK(4,2)=VALMAT(8) 174 : D1HOOK(2,4)=D1HOOK(4,2) 175 : D1HOOK(4,3)=VALMAT(9) 176 : D1HOOK(3,4)=D1HOOK(4,3) 177 : D1HOOK(4,4)=VALMAT(10) 178 : C 179 : C serie de fourier et 3D 180 : C 181 : ELSEIF(IFOU.EQ.1.OR.IFOU.EQ.2)THEN 182 : D1HOOK(1,1)=VALMAT(1) 183 : D1HOOK(2,1)=VALMAT(2) 184 : D1HOOK(1,2)=D1HOOK(2,1) 185 : D1HOOK(2,2)=VALMAT(3) 186 : D1HOOK(3,1)=VALMAT(4) 187 : D1HOOK(1,3)=D1HOOK(3,1) 188 : D1HOOK(3,2)=VALMAT(5) 189 : D1HOOK(2,3)=D1HOOK(3,2) 190 : D1HOOK(3,3)=VALMAT(6) 191 : D1HOOK(4,1)=VALMAT(7) 192 : D1HOOK(1,4)=D1HOOK(4,1) 193 : D1HOOK(4,2)=VALMAT(8) 194 : D1HOOK(2,4)=D1HOOK(4,2) 195 : D1HOOK(4,3)=VALMAT(9) 196 : D1HOOK(3,4)=D1HOOK(4,3) 197 : D1HOOK(4,4)=VALMAT(10) 198 : IF(IFOU.EQ.1)THEN 199 : D1HOOK(5,5)=VALMAT(11) 200 : D1HOOK(6,5)=VALMAT(12) 201 : D1HOOK(5,6)=D1HOOK(6,5) 202 : D1HOOK(6,6)=VALMAT(13) 203 : ELSE 204 : D1HOOK(5,1)=VALMAT(11) 205 : D1HOOK(1,5)=D1HOOK(5,1) 206 : D1HOOK(5,2)=VALMAT(12) 207 : D1HOOK(2,5)=D1HOOK(5,2) 208 : D1HOOK(5,3)=VALMAT(13) 209 : D1HOOK(3,5)=D1HOOK(5,3) 210 : D1HOOK(5,4)=VALMAT(14) 211 : D1HOOK(4,5)=D1HOOK(5,4) 212 : D1HOOK(5,5)=VALMAT(15) 213 : D1HOOK(6,1)=VALMAT(16) 214 : D1HOOK(1,6)=D1HOOK(6,1) 215 : D1HOOK(6,2)=VALMAT(17) 216 : D1HOOK(2,6)=D1HOOK(6,2) 217 : D1HOOK(6,3)=VALMAT(18) 218 : D1HOOK(3,6)=D1HOOK(6,3) 219 : D1HOOK(6,4)=VALMAT(19) 220 : D1HOOK(4,6)=D1HOOK(6,4) 221 : D1HOOK(6,5)=VALMAT(20) 222 : D1HOOK(5,6)=D1HOOK(6,5) 223 : D1HOOK(6,6)=VALMAT(21) 224 : ENDIF 225 : ENDIF 226 : C 227 : ELSE 228 : C 229 : C Formulation milieu poreux 230 : * 231 : * elements massifs 232 : * 233 : IF(MELE.GE.79.AND.MELE.LE.83) THEN 233 : CALL PORMAO(VALMAT,MATE,IFOU,IDIM,TXR,XLOC,XGLOB, 234 : & D1HOOK,ROTHOO,DDHOOK,LHOOK, 235 : & COBMA,XMOB,KCAS,IRET) 236 : GO TO 2035 237 : * 238 : * elements joints 239 : * 240 : ELSE IF(MELE.GE.108.AND.MELE.LE.110) THEN 240 : CALL DOUO88(VALMAT,MATE,IFOU,LHOOK,DDHOOK,IRET) 241 : *********** COBMA ET XMOB PAS DEFINIS !!!! 242 : IRET=0 243 : GO TO 2035 244 : ELSE 245 : IRET=0 246 : GO TO 2035 247 : ENDIF 248 : * 249 : ENDIF 250 : C DEFINITION DES AXES ORTHO./AXES LOCAUX 251 : IF(IDIM.EQ.2)THEN 252 : IF(IFOU.EQ.-2)THEN 253 : XLOC(1,1)=VALMAT(7) 254 : XLOC(2,1)=VALMAT(8) 255 : ELSEIF(IFOU.EQ.-1.OR.IFOU.EQ.0.OR. 256 : + (MFR.EQ.1.AND.IFOU.EQ.-3))THEN 257 : XLOC(1,1)=VALMAT(11) 258 : XLOC(2,1)=VALMAT(12) 259 : ELSEIF(IFOU.EQ.1)THEN 260 : XLOC(1,1)=VALMAT(14) 261 : XLOC(2,1)=VALMAT(15) 262 : ENDIF 263 : XLOC(1,2)=-XLOC(2,1) 264 : XLOC(2,2)=XLOC(1,1) 265 : ELSEIF(IDIM.EQ.3)THEN 266 : XLOC(1,1)=VALMAT(22) 267 : XLOC(2,1)=VALMAT(23) 268 : XLOC(3,1)=VALMAT(24) 269 : XLOC(1,2)=VALMAT(25) 270 : XLOC(2,2)=VALMAT(26) 271 : XLOC(3,2)=VALMAT(27) 272 : C 272 : CALL CROSS2(XLOC(1,1),XLOC(1,2),XLOC(1,3),IRR) 273 : ENDIF 274 : C 275 : C DEFINITION DES AXES ORTHO./AXES GLOBAUX 276 : C 277 : IF(IRET.EQ.1)THEN 278 : C 279 : DO 1045 K=1,IDIM 280 : DO 1045 J=1,IDIM 281 : r_z = 0. 282 : DO 1046 I=1,IDIM 283 : r_z = r_z + TXR(J,I)*XLOC(I,K) 284 : 1046 CONTINUE 285 : XGLOB(K,J) = r_z 286 : 1045 CONTINUE 287 : C MATRICE DE TRANSFORMATION 288 : IF(IDIM.EQ.2)THEN 289 : ROTHOO(1,1)=XGLOB(1,1)*XGLOB(1,1) 290 : ROTHOO(1,2)=XGLOB(1,2)*XGLOB(1,2) 291 : ROTHOO(1,4)=XGLOB(1,1)*XGLOB(1,2) 292 : ROTHOO(2,1)=XGLOB(2,1)*XGLOB(2,1) 293 : ROTHOO(2,2)=XGLOB(2,2)*XGLOB(2,2) 294 : ROTHOO(2,4)=XGLOB(2,1)*XGLOB(2,2) 295 : ROTHOO(3,3)=UN 296 : ROTHOO(4,1)=DEUX*XGLOB(1,1)*XGLOB(2,1) 297 : ROTHOO(4,2)=DEUX*XGLOB(1,2)*XGLOB(2,2) 298 : ROTHOO(4,4)=XGLOB(1,2)*XGLOB(2,1)+XGLOB(1,1)*XGLOB(2,2) 299 : IF(IFOU.EQ.1)THEN 300 : ROTHOO(5,5)=XGLOB(1,1) 301 : ROTHOO(5,6)=XGLOB(1,2) 302 : ROTHOO(6,5)=XGLOB(2,1) 303 : ROTHOO(6,6)=XGLOB(2,2) 304 : ENDIF 305 : ELSEIF(IDIM.EQ.3)THEN 306 : DO 1050 IC=1,3 307 : DO 1050 IL=1,3 308 : ROTHOO(IL,IC)=XGLOB(IL,IC)*XGLOB(IL,IC) 309 : 1050 CONTINUE 310 : C 311 : DO 1060 IL=1,3 312 : ROTHOO(IL,4)=XGLOB(IL,1)*XGLOB(IL,2) 313 : ROTHOO(IL,5)=XGLOB(IL,2)*XGLOB(IL,3) 314 : ROTHOO(IL,6)=XGLOB(IL,1)*XGLOB(IL,3) 315 : 1060 CONTINUE 316 : C 317 : DO 1065 IC=1,3 318 : ROTHOO(4,IC)=DEUX*XGLOB(1,IC)*XGLOB(2,IC) 319 : ROTHOO(5,IC)=DEUX*XGLOB(2,IC)*XGLOB(3,IC) 320 : ROTHOO(6,IC)=DEUX*XGLOB(1,IC)*XGLOB(3,IC) 321 : 1065 CONTINUE 322 : C 323 : DO 1070 IL=4,6 324 : IL1=IL-3 325 : IL2=IL1+1 326 : IF(IL2.GT.3)IL2=IL2-3 327 : DO 1070 IC=4,6 328 : IC1=IC-3 329 : IC2=IC1+1 330 : IF(IC2.GT.3)IC2=IC2-3 331 : ROTHOO(IL,IC)=XGLOB(IL1,IC1)*XGLOB(IL2,IC2)+ 332 : . XGLOB(IL1,IC2)*XGLOB(IL2,IC1) 333 : 1070 CONTINUE 334 : DO 1075 IC=1,6 335 : AA=ROTHOO(6,IC) 336 : ROTHOO(6,IC)=ROTHOO(5,IC) 337 : ROTHOO(5,IC)=AA 338 : 1075 CONTINUE 339 : DO 1080 IL=1,6 340 : AA=ROTHOO(IL,6) 341 : ROTHOO(IL,6)=ROTHOO(IL,5) 342 : ROTHOO(IL,5)=AA 343 : 1080 CONTINUE 344 : ENDIF 345 : C 346 : C TRANSFORMATION DE LA MATRICE DE HOOKE ET DE COBAUX 347 : C 347 : CALL PRODT(DDHOOK,D1HOOK,ROTHOO,LHOOK,LHOOK) 348 : * 349 : IF (MFR.EQ.33) THEN 350 : DO 1085 IL=1,LHOOK 351 : r_z = 0. 352 : DO 1085 IC=1,LHOOK 353 : r_z = r_z + ROTHOO(IC,IL)*COBAUX(IC) 354 : 1085 CONTINUE 355 : COBMA(IL) = r_z 356 : ENDIF 357 : ENDIF 358 : C 359 : ELSEIF (IGAU.LE.NBGMAT.AND. 360 : + (IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN 361 : C 362 : C Cas des barres 363 : C 364 : IF(MFR.EQ.27) THEN 365 : YOU=VALMAT(1) 366 : DDHOOK(1,1)=YOU*SECT 367 : C 368 : ELSE 369 : C 370 : C option non definie 371 : C 372 : IRET=0 373 : ENDIF 374 : ENDIF 375 : C 376 : 2035 RETURN 377 : END 378 : 379 : 380 :
© Cast3M 2003 - All rights reserved.
Disclaimer