Télécharger rigi3.eso

Retour à la liste

Numérotation des lignes :

  1. C RIGI3 SOURCE FANDEUR 16/01/07 21:15:47 8756
  2. SUBROUTINE RIGI3(MATE,MELE,IPMAIL,IPMINT,IPMIN1,NBPGAU,LRE,
  3. & NSTRS,IVAMAT,IVACAR,CMATE,MFR,NBGMAT,NELMAT,IMAT,
  4. & LHOOK,NMATT,LW,NPINT,IPMATR,IIPDPG)
  5. *---------------------------------------------------------------------*
  6. * __________________________ *
  7. * | | *
  8. * | CALCUL DE LA RIGIDITE | *
  9. * |________________________| *
  10. * *
  11. * coq3,dkt,coq4,coq8,coq2,dst
  12. * *
  13. *---------------------------------------------------------------------*
  14. * *
  15. * ENTREES : *
  16. * ________ *
  17. * *
  18. * MATE Numero du materiau *
  19. * MELE Numero de l'element fini *
  20. * IPMAIL Pointeur sur un segment MELEME *
  21. * IPMINT Pointeur sur un segment MINTE aux points de Gauss *
  22. * IPMIN1 pointeur sur un segment MINTE aux noeuds *
  23. * NBPGAU Nombre de point d'integration pour la rigidite *
  24. * LRE Nombre de ddl dans la matrice de rigidite *
  25. * NSTRS Nombre de composante de contraintes/deformations *
  26. * IVAMAT Pointeur sur un segment MPTVAL pour le materiau ou *
  27. * pour une matrice de hooke *
  28. * IVACAR Pointeur sur un segment MPTVAL pour les caracteri- *
  29. * stiques *
  30. * CMATE Nom du materiau *
  31. * MFR Numero de la formulation element fini *
  32. * NBGMAT Taille maxi des melval du materiau (pt de gauss) *
  33. * NELMAT Taille maxi des melval du materiau (No d'element) *
  34. * IMAT (2 il y a une matrice de HOOKE,1 non ) *
  35. * NMATT Nombre de composante de materiau (IMAT=1) *
  36. * NPINT Nombre de points d'integration dans l'epaisseur
  37. * dans le cas des elements de coque integres
  38. *
  39. * *
  40. * SORTIES : *
  41. * ________ *
  42. * *
  43. * IPMATR pointeur sur la rigidite de la sous-zone *
  44. * *
  45. *---------------------------------------------------------------------*
  46. IMPLICIT INTEGER(I-N)
  47. IMPLICIT REAL*8(A-H,O-Z)
  48. *
  49. -INC CCOPTIO
  50. -INC CCHAMP
  51. -INC CCREEL
  52. *-
  53. -INC SMCHAML
  54. -INC SMINTE
  55. -INC SMELEME
  56. -INC SMRIGID
  57. -INC SMMODEL
  58. -INC SMCOORD
  59. -INC SMLREEL
  60. *
  61. SEGMENT WRK1
  62. REAL*8 DDHOOK(LHOOK,LHOOK) ,DDHOMU(LHOOK,LHOOK)
  63. REAL*8 REL(LRE,LRE) , XE(3,NBBB)
  64. ENDSEGMENT
  65. *
  66. SEGMENT WRK2
  67. REAL*8 SHPWRK(6,NBNO) ,BGENE(LHOOK,LRE)
  68. ENDSEGMENT
  69. *
  70. SEGMENT WRK3
  71. REAL*8 WORK(LW)
  72. ENDSEGMENT
  73. *
  74. SEGMENT WRK4
  75. REAL*8 BPSS(3,3) ,XEL(3,NBBB)
  76. ENDSEGMENT
  77. *
  78. SEGMENT WRK5
  79. REAL*8 BGENE1(LHOOK,LRE),POIG(NBPGA1)
  80. ENDSEGMENT
  81. *
  82. SEGMENT,MVELCH
  83. REAL*8 VALMAT(NV1)
  84. ENDSEGMENT
  85. *
  86. SEGMENT MPTVAL
  87. INTEGER IPOS(NS) ,NSOF(NS)
  88. INTEGER IVAL(NCOSOU)
  89. CHARACTER*16 TYVAL(NCOSOU)
  90. ENDSEGMENT
  91. *
  92. CHARACTER*8 CMATE
  93. *
  94. * write(6,*) 'entree dans rigi3 lhook',lhook
  95. *
  96. C INITIALISATION DU POINT AUTOUR DUQUEL SE FAIT LE MOUVEMENT
  97. C DE LA SECTION EN DEFO PLANE GENERALISEE
  98. IF (IIPDPG.GT.0) THEN
  99. C <- test equivalent ici a IFOUR.EQ.-3
  100. C SEGACT MCOORD
  101. IREF=(IIPDPG-1)*(IDIM+1)
  102. XDPGE=XCOOR(IREF+1)
  103. YDPGE=XCOOR(IREF+2)
  104. ELSE
  105. XDPGE=XZERO
  106. YDPGE=XZERO
  107. ENDIF
  108. *
  109. MELEME=IPMAIL
  110. NBNN=NUM(/1)
  111. NBELEM=NUM(/2)
  112. *
  113. NV1=NMATT
  114. SEGINI,MVELCH
  115. *
  116. XMATRI=IPMATR
  117. C* NLIGRP=LRE
  118. C* NLIGRD=LRE
  119. *
  120. NHRM=NIFOUR
  121. *
  122. MINTE=IPMINT
  123. IRTD=1
  124. C
  125. C_______________________________________________________________________
  126. C
  127. C NUMERO DES ETIQUETTES :
  128. C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  129. C DANS LA ZONE SPECIFIQUE A CHAQUE ELEMENT COMMENCANT PAR :
  130. C 5 CONTINUE
  131. C ELEMENT 5 ETIQUETTES 1005 2005 3005 4005 ...
  132. C 44 CONTINUE
  133. C ELEMENT 44 ETIQUETTES 1044 2044 3044 4044 ...
  134. C_______________________________________________________________________
  135. C
  136. GOTO(99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  137. 1 99,99,99,99,99,99,27,28,99,99,99,99,99,99,99,99,99,99,99,99,
  138. 2 41,99,99,44,28,99,99,99,49,99,99,99,99,99,99,41,99,99,99,99,
  139. 3 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  140. 4 99,99,99,99,99,99,99,99,99,99,99,99,93,99,99,99,99),MELE
  141. GOTO 99
  142. C_______________________________________________________________________
  143. C
  144. C ELEMENT COQ3
  145. C_______________________________________________________________________
  146. C
  147. 27 CONTINUE
  148. NBBB=NBNN
  149. SEGINI WRK1,WRK3
  150. C
  151. C BOUCLE DE CALCUL POUR LES DIFFERENTS ELEMENTS
  152. C
  153. DO 3027 IB=1,NBELEM
  154. C
  155. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  156. C
  157. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  158. C
  159. C ON CHERCHE LES COEFF DES MAT DE HOOKE
  160. C
  161. MPTVAL=IVAMAT
  162. IF(IMAT.EQ.2) THEN
  163. IF (IB.LE.NELMAT.OR.NBGMAT.GT.1) THEN
  164. MELVAL=IVAL(1)
  165. IBMN=MIN(IB ,IELCHE(/2))
  166. MLREEL=IELCHE(1,IBMN)
  167. SEGACT MLREEL
  168. CALL DOHOOO(PROG,LHOOK,DDHOOK)
  169. * write(6,*)((ddhook(IU,io),iu=1,4),io=1,4)
  170. SEGDES MLREEL
  171. ENDIF
  172. ELSE IF (IMAT.EQ.1) THEN
  173. DO 9027 IM=1,NMATT
  174. IF (IVAL(IM).NE.0) THEN
  175. MELVAL=IVAL(IM)
  176. IBMN=MIN(IB ,VELCHE(/2))
  177. VALMAT(IM)=VELCHE(1,IBMN)
  178. ELSE
  179. VALMAT(IM)=0.D0
  180. ENDIF
  181. 9027 CONTINUE
  182. IF (IB.LE.NELMAT.OR.NBGMAT.GT.1)
  183. 1 CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  184. * write(6,*)((ddhook(IU,io),iu=1,4),io=1,4)
  185. ENDIF
  186. C
  187. C CHERCHER LES EPAISSEUR ET EXCENTREMENT
  188. C
  189. MPTVAL=IVACAR
  190. MELVAL=IVAL(1)
  191. IBMN=MIN(IB,VELCHE(/2))
  192. EPAIST=VELCHE(1,IBMN)
  193. IF (IVAL(2).NE.0) THEN
  194. MELVAL=IVAL(2)
  195. IBMN=MIN(IB,VELCHE(/2))
  196. EXCEN =VELCHE(1,IBMN)
  197. IF (EXCEN.NE.0.D0) THEN
  198. CALL ERREUR(474)
  199. GO TO 9927
  200. ENDIF
  201. ELSE
  202. EXCEN=0.D0
  203. ENDIF
  204. C
  205. C ON CALCULE SA RAIDEUR
  206. C
  207. CALL COQ3RI(REL,XE,EPAIST,DDHOOK,WORK)
  208. C
  209. 4027 CONTINUE
  210. C
  211. C REMPLISSAGE DE XMATRI
  212. C
  213. CALL REMPMT(REL,LRE,RE(1,1,ib))
  214. 3027 CONTINUE
  215.  
  216. IF(IRTD.EQ.0) THEN
  217. MOTERR(1:8)=CMATE
  218. MOTERR(9:16)=NOMFR(MFR/2+1)
  219. INTERR(1)=IFOUR
  220. CALL ERREUR(81)
  221. ENDIF
  222. 9927 CONTINUE
  223. SEGSUP WRK1,WRK3
  224. GOTO 510
  225. C_______________________________________________________________________
  226. C
  227. C ELEMENT DKT
  228. C_______________________________________________________________________
  229. C
  230. 28 CONTINUE
  231. NBNO=NBNN
  232. NBBB=NBNN
  233. SEGINI WRK1,WRK2,WRK4
  234. IF(NPINT.NE.0)THEN
  235. NBPGA1=NBPGAU/NPINT
  236. IF(NBGMAT.NE.1)THEN
  237. NBPGEP=NPINT
  238. ELSE
  239. NBPGEP=1
  240. ENDIF
  241. SEGINI WRK5
  242. DO 1028 IG=1,NBPGA1
  243. POIG(IG)=POIGAU(IG)
  244. 1028 CONTINUE
  245. Ccccc CALL POIDNW(NPINT,NBPGA1,2,POIG)
  246. CALL SIMPSN(NPINT,NBPGA1,2,POIG)
  247. ENDIF
  248. C
  249. DO 3028 IB=1,NBELEM
  250. C
  251. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  252. C
  253. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  254. C
  255. CALL VPAST(XE,BPSS)
  256. C BPSS STOCKE LA MATRICE DE PASSAGE
  257. CALL VCORLC (XE,XEL,BPSS)
  258. CALL ZERO (REL,LRE,LRE)
  259. C
  260. C ON CHERCHE LES EPAISEURS ET ON LES MOYENNE,
  261. C LES EXCENTREMENTS ET ON LES MOYENNE.
  262. C
  263. MPTVAL=IVACAR
  264. MELVAL=IVAL(1)
  265. EPAIST=0.D0
  266. IF (MELVAL.NE.0) THEN
  267. DO IGAU=1,NBPGAU
  268. IGMN=MIN(IGAU,VELCHE(/1))
  269. IBMN=MIN(IB,VELCHE(/2))
  270. EPAIST=EPAIST+VELCHE(IGMN,IBMN)
  271. ENDDO
  272. EPAIST=EPAIST/NBPGAU
  273. ENDIF
  274. *
  275. MELVAL=IVAL(2)
  276. EXCEN=0.D0
  277. IF (MELVAL.NE.0) THEN
  278. DO IGAU=1,NBPGAU
  279. IGMN=MIN(IGAU,VELCHE(/1))
  280. IBMN=MIN(IB,VELCHE(/2))
  281. EXCEN=EXCEN+VELCHE(IGMN,IBMN)
  282. ENDDO
  283. EXCEN=EXCEN/NBPGAU
  284. ENDIF
  285. C
  286. IF(NPINT.EQ.0)THEN
  287. C
  288. C COQUE GLOBAL
  289. C
  290. C BOUCLE SUR LES POINTS DE GAUSS
  291. C
  292. DO 1128 IGAU=1,NBPGAU
  293. *
  294. CALL BMAT28(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU,
  295. & MELE,MFR,NBNO,LRE,IFOUR,NSTRS,0,1.D0,XEL,
  296. & SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  297. DJAC=DJAC*POIGAU(IGAU)
  298. C
  299. C ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT
  300. C
  301. IF (EXCEN.NE.0.) THEN
  302. DO 1528 IJL=1,3
  303. DO 1528 IJC=1,LRE
  304. BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  305. 1528 CONTINUE
  306. ENDIF
  307. C
  308. C ON CHERCHE LES COEFFICIENTS DE LA MATRICE DE HOOKE
  309. C
  310. MPTVAL=IVAMAT
  311. IF(IMAT.EQ.2) THEN
  312. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  313. MELVAL=IVAL(1)
  314. IBMN=MIN(IB ,IELCHE(/2))
  315. IGMN=MIN(IGAU,IELCHE(/1))
  316. MLREEL=IELCHE(IGMN,IBMN)
  317. SEGACT MLREEL
  318. CALL DOHOOO(PROG,LHOOK,DDHOOK)
  319. SEGDES MLREEL
  320. ENDIF
  321. CALL BDBS1(BGENE,DJAC,DDHOOK,LRE,NSTRS,REL,MFR,IFOUR,MATE,
  322. 1 IGAU,IMAT,EXCEN)
  323. ELSE IF (IMAT.EQ.1) THEN
  324. *
  325. DO 9028 IM=1,NMATT
  326. IF (IVAL(IM).NE.0) THEN
  327. MELVAL=IVAL(IM)
  328. IBMN=MIN(IB ,VELCHE(/2))
  329. IGMN=MIN(IGAU,VELCHE(/1))
  330. VALMAT(IM)=VELCHE(IGMN,IBMN)
  331. ELSE
  332. VALMAT(IM)=0.D0
  333. ENDIF
  334. 9028 CONTINUE
  335. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  336. 1 CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  337. CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  338. CALL BDBS1(BGENE,DJAC,DDHOMU,LRE,NSTRS,REL,MFR,IFOUR,MATE,
  339. 1 IGAU,IMAT,EXCEN)
  340. ENDIF
  341. 1128 CONTINUE
  342. C
  343. ELSE
  344. C
  345. C COQUE INTEGREE
  346. C
  347. C BOUCLE SUR LES POINTS DE GAUSS DE LA SURFACE
  348. C
  349. DO 1101 IGAU=1,NBPGA1
  350. *
  351. CALL BMAT28(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU,
  352. & MELE,MFR,NBNO,LRE,IFOUR,LHOOK,0,1.D0,XEL,
  353. & SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  354. C
  355. C ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT
  356. C
  357. IF (EXCEN.NE.0.) THEN
  358. DO 1501 IJL=1,3
  359. DO 1501 IJC=1,LRE
  360. BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  361. 1501 CONTINUE
  362. ENDIF
  363. C
  364. C BOUCLE SUR LES NAPPES DANS L'EPAISSEUR
  365. C
  366. DO 1102 INAP=1,NBPGEP
  367. C
  368. IGAU1=(INAP-1)*NBPGA1+IGAU
  369. C
  370. C CALCUL DE LA MATRICE B CORRESPONDANT AUX DEFORMATIONS 3D
  371. C
  372. IF(NBGMAT.EQ.1.AND.NPINT.NE.1)THEN
  373. ZZZ2 = SQRT( (EPAIST**3.D0)/12.D0 )
  374. ZZZ1 = SQRT( EPAIST )
  375. DO 1503 IJL=1,3
  376. DO 1503 IJC=1,LRE
  377. BGENE1(IJL,IJC) =ZZZ1*BGENE(IJL,IJC)
  378. BGENE1(IJL+3,IJC)=ZZZ2*BGENE(IJL+3,IJC)
  379. 1503 CONTINUE
  380. DJAC1=DJAC*POIG(IGAU1)
  381. ELSE
  382. ZZZ=DZEGAU(IGAU1)*(EPAIST/2.D0)
  383. DO 1502 IJL=1,3
  384. DO 1502 IJC=1,LRE
  385. BGENE1(IJL,IJC)=BGENE(IJL,IJC)
  386. BGENE1(IJL+3,IJC)=ZZZ*BGENE(IJL+3,IJC)
  387. 1502 CONTINUE
  388. DJAC1=DJAC*POIGAU(IGAU1)*(EPAIST/2.D0)
  389. ENDIF
  390. C
  391. C ON CHERCHE LA MATRICE DE HOOKE
  392. C
  393. MPTVAL=IVAMAT
  394. IF(IMAT.EQ.2) THEN
  395. IF (IGAU1.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  396. MELVAL=IVAL(1)
  397. IBMN=MIN(IB ,IELCHE(/2))
  398. IGMN=MIN(IGAU1,IELCHE(/1))
  399. MLREEL=IELCHE(IGMN,IBMN)
  400. SEGACT MLREEL
  401. CALL DHDKTI(PROG,LHOOK,DDHOOK)
  402. SEGDES MLREEL
  403. * write(6,*)((ddhook(IU,io),iu=1,6),io=1,6)
  404. ENDIF
  405. ELSE IF (IMAT.EQ.1) THEN
  406. DO 9001 IM=1,NMATT
  407. IF (IVAL(IM).NE.0) THEN
  408. MELVAL=IVAL(IM)
  409. IBMN=MIN(IB ,VELCHE(/2))
  410. IGMN=MIN(IGAU1,VELCHE(/1))
  411. VALMAT(IM)=VELCHE(IGMN,IBMN)
  412. ELSE
  413. VALMAT(IM)=0.D0
  414. ENDIF
  415. 9001 CONTINUE
  416. IF (IGAU1.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  417. 1 CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  418. * write(6,*)((ddhook(IU,io),iu=1,6),io=1,6)
  419. ENDIF
  420. CALL BDBS1(BGENE1,DJAC1,DDHOOK,LRE,LHOOK,REL,MFR,IFOUR,MATE,
  421. 1 IGAU,IMAT,EXCEN)
  422. 1102 CONTINUE
  423. 1101 CONTINUE
  424. ENDIF
  425. REL(6,6)=REL(5,5)*1.D-7
  426. REL(12,12)=REL(6,6)
  427. REL(18,18)=REL(6,6)
  428. ICOM=0
  429. IF(ABS(EXCEN).GT.XPETIT .OR. CMATE.EQ.'COMPOSIT'
  430. 1 .OR. IMAT.EQ.2) ICOM=1
  431. CALL TRANSK(REL,BPSS,LRE,3,ICOM)
  432. C
  433. C REMPLISSAGE DE XMATRI
  434. C
  435. CALL REMPMT(REL,LRE,RE(1,1,IB))
  436. 3028 CONTINUE
  437. IF(IRTD.EQ.0) THEN
  438. MOTERR(1:8)=CMATE
  439. MOTERR(9:16)=NOMFR(MFR/2+1)
  440. INTERR(1)=IFOUR
  441. CALL ERREUR(81)
  442. ENDIF
  443. SEGSUP WRK1,WRK2,WRK4
  444. IF(NPINT.NE.0)SEGSUP WRK5
  445. GOTO 510
  446. C_______________________________________________________________________
  447. C
  448. C ELEMENT COQ8
  449. C_______________________________________________________________________
  450. C
  451. 41 CONTINUE
  452. NBBB=NBNN
  453. NBNO=NBNN
  454. SEGINI WRK1,WRK2,WRK3
  455. MINTE1=IPMIN1
  456. SEGACT MINTE1
  457. NBPGA1=MINTE1.SHPTOT(/3)
  458. NBN1 =MINTE1.SHPTOT(/2)
  459. C
  460. C BOUCLE DE CALCUL POUR LES DIFFERENTS ELEMENTS
  461. C
  462. DO 3041 IB=1,NBELEM
  463. C
  464. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  465. C
  466. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  467. C
  468. CALL ZERO (REL,LRE,LRE)
  469. C
  470. C ON CHERCHE LES EPAISSEURS ET LES EXCENTREMENTS.
  471. C
  472. MPTVAL=IVACAR
  473. DO 4041 IGAU=1,NBPGAU
  474. MELVAL=IVAL(1)
  475. IGMN=MIN(IGAU,VELCHE(/1))
  476. IBMN=MIN(IB,VELCHE(/2))
  477. WORK(IGAU) =VELCHE(IGMN,IBMN)
  478. IF (IVAL(2).NE.0) THEN
  479. MELVAL=IVAL(2)
  480. IGMN=MIN(IGAU,VELCHE(/1))
  481. IBMN=MIN(IB,VELCHE(/2))
  482. WORK(10+IGAU)=VELCHE(IGMN,IBMN)
  483. ELSE
  484. WORK(10+IGAU)=0.D0
  485. ENDIF
  486. 4041 CONTINUE
  487. C
  488. C DETERMINATION DES AXES LOCAUX AUX NOEUDS
  489. C
  490. CALL CQ8LOC(XE,NBNN,MINTE1.SHPTOT,WORK(21),IRR)
  491. C
  492. C BOUCLE SUR LES POINTS DE GAUSS
  493. C
  494. DO 3042 IGAU=1,NBPGAU
  495. E3=DZEGAU(IGAU)
  496. CALL BCOQ8E(IGAU,XE,NBNN,WORK(1),WORK(11),BGENE,DJAC,
  497. 1 E3,SHPTOT,WORK(21),IRR)
  498. C
  499. C GESTION D'ERREUR: IRR=0 CORRESPOND A UN VECTEUR NUL (CF. CROSS2)
  500. C IRR=-1 CORRESPOND A UN JACOBIEN NUL(CF. SHLJAC)
  501. C
  502. IF(IRR.EQ.0) THEN
  503. CALL ERREUR(241)
  504. GOTO 9941
  505. ELSE IF(IRR.EQ.-1)THEN
  506. CALL ERREUR(240)
  507. GOTO 9941
  508. ENDIF
  509. C
  510. DJAC=ABS(DJAC)*POIGAU(IGAU)
  511. C
  512. C ON CHERCHE LES COEFF DES MAT DE HOOKE
  513. C
  514. MPTVAL=IVAMAT
  515. IF(IMAT.EQ.2) THEN
  516. IF ((IGAU.LE.NBGMAT).AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  517. MELVAL=IVAL(1)
  518. IBMN=MIN(IB ,IELCHE(/2))
  519. IGMN=MIN(IGAU,IELCHE(/1))
  520. MLREEL=IELCHE(IGMN,IBMN)
  521. SEGACT MLREEL
  522. CALL DOHOOO(PROG,LHOOK,DDHOOK)
  523. SEGDES MLREEL
  524. ENDIF
  525. ELSE IF (IMAT.EQ.1) THEN
  526. DO 9041 IM=1,NMATT
  527. IF (IVAL(IM).NE.0) THEN
  528. MELVAL=IVAL(IM)
  529. IBMN=MIN(IB ,VELCHE(/2))
  530. IGMN=MIN(IGAU,VELCHE(/1))
  531. VALMAT(IM)=VELCHE(IGMN,IBMN)
  532. ELSE
  533. VALMAT(IM)=0.D0
  534. ENDIF
  535. 9041 CONTINUE
  536. IF((IGAU.LE.NBGMAT).AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  537. 1 CALL DOHCOE (VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  538. ENDIF
  539. C
  540. C ON CALCULE SA RAIDEUR
  541. C
  542. CALL COQ8RI(BGENE,DJAC,DDHOOK,LRE,NBPGAU,IGAU,NBNN,REL)
  543. C
  544. 3042 CONTINUE
  545. C
  546. C REMPLISSAGE DE XMATRI
  547. C
  548. CALL REMPMT(REL,LRE,RE(1,1,IB))
  549. 3041 CONTINUE
  550. c
  551. IF(IRTD.EQ.0) THEN
  552. MOTERR(1:8)=CMATE
  553. MOTERR(9:16)=NOMFR(MFR/2+1)
  554. INTERR(1)=IFOUR
  555. CALL ERREUR(81)
  556. ENDIF
  557. 9941 CONTINUE
  558. SEGSUP WRK1,WRK2,WRK3
  559. SEGDES MINTE1
  560. GOTO 510
  561. C_______________________________________________________________________
  562. C
  563. C SECTEUR DE CALCUL POUR LE COQ2
  564. C_______________________________________________________________________
  565. C
  566. 44 CONTINUE
  567. DIM3=1.D0
  568. NBNO=NBNN
  569. NBBB=NBNN
  570. SEGINI WRK1,WRK2
  571. DO 3044 IB=1,NBELEM
  572. C
  573. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  574. C
  575. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  576. C
  577. CALL ZERO (REL,LRE,LRE)
  578. C
  579. C BOUCLE SUR LES POINTS DE GAUSS
  580. C
  581. DO 4044 IGAU=1,NBPGAU
  582. MPTVAL=IVACAR
  583. MELVAL=IVAL(1)
  584. IBMN=MIN(IB,VELCHE(/2))
  585. EPAIST=VELCHE(1,IBMN)
  586. IF (IVAL(2).NE.0) THEN
  587. MELVAL=IVAL(2)
  588. IBMN=MIN(IB,VELCHE(/2))
  589. EXCEN =VELCHE(1,IBMN)
  590. ELSE
  591. EXCEN=0.D0
  592. ENDIF
  593. IF (IFOUR.EQ.-2) THEN
  594. IF (IVAL(3).NE.0) THEN
  595. MELVAL=IVAL(3)
  596. IBMN=MIN(IB,VELCHE(/2))
  597. DIM3 =VELCHE(1,IBMN)
  598. ELSE
  599. DIM3=1.D0
  600. ENDIF
  601. ENDIF
  602. C
  603. C APPEL A BCOQ2 ...
  604. C
  605. CALL BCOQ2(BGENE,NSTRS,DJAC,IGAU,IFOUR,XE,NHRM,QSIGAU,POIGAU,
  606. . EXCEN,DIM3,IRRT,XDPGE,YDPGE)
  607. C
  608. C GESTION D'ERREUR
  609. C LES ERREURS PREVUES SONT LONGEUR DE L'ELEMENT =0 OU RAYON
  610. C AU POINT D'INTEGRATION =0 OU RAPPORT R/L TROP PETIT (INFERIEUR
  611. C A 1.E-3).
  612. C
  613. IF(IRRT.EQ.1) THEN
  614. INTERR(1)=IB
  615. CALL ERREUR(255)
  616. GOTO 9944
  617. ELSE IF (IRRT.EQ.2) THEN
  618. INTERR(1)=IB
  619. CALL ERREUR(256)
  620. GOTO 9944
  621. ENDIF
  622. C
  623. MPTVAL=IVAMAT
  624. IF(IMAT.EQ.2) THEN
  625. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  626. MELVAL=IVAL(1)
  627. IBMN=MIN(IB ,IELCHE(/2))
  628. IGMN=MIN(IGAU,IELCHE(/1))
  629. MLREEL=IELCHE(IGMN,IBMN)
  630. SEGACT MLREEL
  631. CALL DOHOOO(PROG,LHOOK,DDHOOK)
  632. SEGDES MLREEL
  633. ENDIF
  634. CALL BDBST(BGENE,DJAC,DDHOOK,LRE,NSTRS,REL)
  635. ELSE IF (IMAT.EQ.1) THEN
  636. *
  637. DO 9044 IM=1,NMATT
  638. IF (IVAL(IM).NE.0) THEN
  639. MELVAL=IVAL(IM)
  640. IBMN=MIN(IB ,VELCHE(/2))
  641. IGMN=MIN(IGAU,VELCHE(/1))
  642. VALMAT(IM)=VELCHE(IGMN,IBMN)
  643. ELSE
  644. VALMAT(IM)=0.D0
  645. ENDIF
  646. 9044 CONTINUE
  647. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  648. 1 CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  649. CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  650. CALL BDBST(BGENE,DJAC,DDHOMU,LRE,NSTRS,REL)
  651. ENDIF
  652. 4044 CONTINUE
  653. C
  654. C REMPLISSAGE DE XMATRI
  655. C
  656. CALL REMPMT(REL,LRE,RE(1,1,IB))
  657. 3044 CONTINUE
  658. C
  659. C IMPRESSION D'UN EVENTUEL MESSAGE D'ERREUR...
  660. IF(IRTD.EQ.0) THEN
  661. MOTERR(1:8)=CMATE
  662. MOTERR(9:16)=NOMFR(MFR/2+1)
  663. INTERR(1)=IFOUR
  664. CALL ERREUR(81)
  665. ENDIF
  666. 9944 CONTINUE
  667. SEGSUP WRK1,WRK2
  668. GOTO 510
  669. C_______________________________________________________________________
  670. C
  671. C SECTEUR DE CALCUL POUR LE COQ4
  672. C_______________________________________________________________________
  673. C
  674. 49 CONTINUE
  675. NBNO=NBNN
  676. NBBB=NBNN
  677. SEGINI WRK1,WRK2,WRK4
  678. c
  679. c ... Si le matériau n'est pas isotrope, dans le cas général les
  680. c tensions et le cisaillement NE sont PAS découplées. Ce qui veut
  681. c dire qu'on n'a pas le droit de les intégrer différemment ...
  682. c
  683. DO 3049 IB=1,NBELEM
  684. C
  685. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  686. C
  687. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  688. C
  689. CALL ZERO (REL,LRE,LRE)
  690. CALL CQ4LOC(XE,XEL,BPSS,IRRT,1)
  691. C IRRT=1 NODI TROPPO VICINI
  692. IF(IRRT.EQ.1) THEN
  693. INTERR(1)=IB
  694. CALL ERREUR(323)
  695. GOTO 9949
  696. ELSE IF(IRRT.EQ.3) THEN
  697. IRRT = 0
  698. NOPLAN = 1
  699. ELSE
  700. NOPLAN = 0
  701. ENDIF
  702. C
  703. C BOUCLE SUR LES POINTS DE GAUSS
  704. C
  705. MPTVAL=IVACAR
  706. MELVAL=IVAL(1)
  707. IBMN=MIN(IB,VELCHE(/2))
  708. EPAIST=VELCHE(1,IBMN)
  709. IF (IVAL(2).NE.0) THEN
  710. MELVAL=IVAL(2)
  711. IBMN=MIN(IB,VELCHE(/2))
  712. EXCEN =VELCHE(1,IBMN)
  713. ELSE
  714. EXCEN=0.D0
  715. ENDIF
  716. DO 4049 IGAU=1,NBPGAU
  717. C
  718. C APPEL A BCOQ4
  719. C
  720. if(cmate.eq.'ISOTROPE') then
  721. CALL BCOQ4(IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,EXCEN,NOPLAN,IRRT,
  722. + 0)
  723. else
  724. CALL BCOQ4O(IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,EXCEN,NOPLAN,IRRT,
  725. + 0)
  726. endif
  727. DJAC=DJAC*POIGAU(IGAU)
  728. C IRRT=1 JACOBIANO <= 0
  729. IF(IRRT.EQ.1) THEN
  730. INTERR(1)=IB
  731. CALL ERREUR(321)
  732. GOTO 9949
  733. ENDIF
  734. C
  735. MPTVAL=IVAMAT
  736. IF(IMAT.EQ.2) THEN
  737. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  738. MELVAL=IVAL(1)
  739. IBMN=MIN(IB ,IELCHE(/2))
  740. IGMN=MIN(IGAU,IELCHE(/1))
  741. MLREEL=IELCHE(IGMN,IBMN)
  742. SEGACT MLREEL
  743. CALL DOHOOO(PROG,LHOOK,DDHOOK)
  744. SEGDES MLREEL
  745. ENDIF
  746. CALL BDBST(BGENE,DJAC,DDHOOK,LRE,NSTRS,REL)
  747. ELSE IF (IMAT.EQ.1) THEN
  748. *
  749. DO 9049 IM=1,NMATT
  750. IF (IVAL(IM).NE.0) THEN
  751. MELVAL=IVAL(IM)
  752. IBMN=MIN(IB ,VELCHE(/2))
  753. IGMN=MIN(IGAU,VELCHE(/1))
  754. VALMAT(IM)=VELCHE(IGMN,IBMN)
  755. ELSE
  756. VALMAT(IM)=0.D0
  757. ENDIF
  758. 9049 CONTINUE
  759. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  760. 1 CALL DOHCIS(VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  761. CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  762. if(cmate.eq.'ISOTROPE') then
  763. CALL COQ4RI (IGAU,BGENE,DJAC,EXCEN,NOPLAN,DDHOMU,REL)
  764. else
  765. CALL COQ4RJ (IGAU,BGENE,DJAC,EXCEN,NOPLAN,DDHOMU,REL)
  766. endif
  767. ENDIF
  768. 4049 CONTINUE
  769. C
  770. REL(6,6)=REL(5,5)*1.D-7
  771. REL(12,12)=REL(6,6)
  772. REL(18,18)=REL(6,6)
  773. REL(24,24)=REL(6,6)
  774. ICOM=0
  775. IF(ABS(EXCEN).GT.XPETIT .OR.CMATE.EQ.'COMPOSIT'
  776. 1 .OR. IMAT.EQ.2) ICOM=1
  777. CALL TRANSK(REL,BPSS,LRE,4,ICOM)
  778. C
  779. C REMPLISSAGE DE XMATRI
  780. C
  781. CALL REMPMT(REL,LRE,RE(1,1,IB))
  782. 3049 CONTINUE
  783. C
  784. C IMPRESSION D'UN EVENTUEL MESSAGE D'ERREUR...
  785. IF(IRTD.EQ.0) THEN
  786. MOTERR(1:8)=CMATE
  787. MOTERR(9:16)=NOMFR(MFR/2+1)
  788. INTERR(1)=IFOUR
  789. CALL ERREUR(81)
  790. ENDIF
  791. 9949 CONTINUE
  792. SEGSUP WRK1,WRK2,WRK4
  793. GOTO 510
  794. C_______________________________________________________________________
  795. C
  796. C ELEMENT DST
  797. C_______________________________________________________________________
  798. C
  799. 93 CONTINUE
  800. NBNO=NBNN
  801. NBBB=NBNN
  802. SEGINI WRK1,WRK2,WRK3,WRK4
  803. IF(CMATE.NE.'ISOTROPE')THEN
  804. MPTVAL=IVAMAT
  805. IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  806. MELVAL=IVAL(7)
  807. ELSE
  808. MELVAL=IVAL(2)
  809. ENDIF
  810. NBGCOS=VELCHE(/1)
  811. ENDIF
  812. DO 3093 IB=1,NBELEM
  813. C
  814. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  815. C
  816. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  817. C
  818. CALL VPAST(XE,BPSS)
  819. C BPSS STOCKE LA MATRICE DE PASSAGE
  820. CALL VCORLC (XE,XEL,BPSS)
  821. CALL ZERO (REL,LRE,LRE)
  822. C
  823. C BOUCLE SUR LES POINTS DE GAUSS
  824. C
  825. DO 1193 IGAU=1,NBPGAU
  826. MPTVAL=IVACAR
  827. MELVAL=IVAL(1)
  828. IBMN =MIN(IB,VELCHE(/2))
  829. EPAIST=VELCHE(1,IBMN)
  830. IF (IVAL(2).NE.0) THEN
  831. MELVAL=IVAL(2)
  832. IBMN =MIN(IB,VELCHE(/2))
  833. EXCEN =VELCHE(1,IBMN)
  834. ELSE
  835. EXCEN=0.D0
  836. ENDIF
  837. *
  838. * Dans le cas des matériaux orthotropes, les déformations sont d'abord
  839. * calculées dans le repère d'orthotropie (les formules utilisées par les
  840. * routines RCDST et BMFDST ne sont valables que dans ce repère); elles
  841. * sont ensuite exprimées dans le repère local de l'élément.
  842. *
  843. IF(CMATE.NE.'ISOTROPE')THEN
  844. IF(IGAU.LE.NBGCOS)THEN
  845. IF(IMAT.EQ.2)THEN
  846. MPTVAL=IVAMAT
  847. MELVAL=IVAL(2)
  848. IBMN=MIN(IB ,VELCHE(/2))
  849. IGMN=MIN(IGAU,VELCHE(/1))
  850. COSA=VELCHE(IGMN,IBMN)
  851. MELVAL=IVAL(3)
  852. IBMN=MIN(IB ,VELCHE(/2))
  853. IGMN=MIN(IGAU,VELCHE(/1))
  854. SINA=VELCHE(IGMN,IBMN)
  855. ENDIF
  856. ENDIF
  857. ENDIF
  858. C
  859. C ON CHERCHE LES COEFFICIENTS DE LA MATRICE DE HOOKE
  860. C
  861. MPTVAL=IVAMAT
  862. IF(IMAT.EQ.2) THEN
  863. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.
  864. + OR.NBGMAT.GT.1)) THEN
  865. MELVAL=IVAL(1)
  866. IBMN=MIN(IB ,IELCHE(/2))
  867. IGMN=MIN(IGAU,IELCHE(/1))
  868. MLREEL=IELCHE(IGMN,IBMN)
  869. SEGACT MLREEL
  870. CALL DOHOOO(PROG,LHOOK,DDHOMU)
  871. SEGDES MLREEL
  872. IF(CMATE.EQ.'ORTHOTRO')
  873. + CALL CHGREP1(COSA,SINA,DDHOMU,LHOOK)
  874. ENDIF
  875. ELSE IF (IMAT.EQ.1) THEN
  876. *
  877. DO 9093 IM=1,NMATT
  878. IF (IVAL(IM).NE.0) THEN
  879. MELVAL=IVAL(IM)
  880. IBMN=MIN(IB ,VELCHE(/2))
  881. IGMN=MIN(IGAU,VELCHE(/1))
  882. VALMAT(IM)=VELCHE(IGMN,IBMN)
  883. ELSE
  884. VALMAT(IM)=0.D0
  885. ENDIF
  886. 9093 CONTINUE
  887. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  888. 1 CALL DOHDST(VALMAT,CMATE,IFOUR,NSTRS,DDHOOK,IRTD)
  889. CALL HOOKMU(EPAIST,0.D0,NSTRS,DDHOOK,DDHOMU)
  890. ENDIF
  891. *
  892. CALL ZERO(BGENE,NSTRS,LRE)
  893. IF(CMATE.NE.'ISOTROPE')THEN
  894. IF(IGAU.LE.NBGCOS)THEN
  895. IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  896. COSA=VALMAT(7)
  897. SINA=VALMAT(8)
  898. ENDIF
  899. DO 1393 INO=1,NBNN
  900. XX=COSA*XEL(1,INO)+SINA*XEL(2,INO)
  901. YY=(-SINA)*XEL(1,INO)+COSA*XEL(2,INO)
  902. XE(1,INO)=XX
  903. XE(2,INO)=YY
  904. 1393 CONTINUE
  905. ENDIF
  906. CC
  907. C TERMES DE LA MATRICE DE RIGIDITE RELATIFS
  908. C AUX CISAILLEMENTS TRANSVERSES
  909. C
  910. CALL RCDST(XE,NSTRS,LRE,DDHOMU,
  911. 1 WORK(1),WORK(10),WORK(19),REL,BGENE,1)
  912.  
  913. C TERMES DE LA MATRICE B RELATIFS AUX EFFETS
  914. C DE MEMBRANE ET DE FLEXION
  915. C
  916. CALL BMFDST(IGAU,XE,NSTRS,QSIGAU,ETAGAU,SHPTOT,SHPWRK,
  917. 1 WORK(1),WORK(10),WORK(19),BGENE,DUM)
  918. *
  919. DO 10 NPOI=1,3
  920. SHPWRK(1,NPOI)=SHPTOT(1,NPOI,IGAU)
  921. SHPWRK(2,NPOI)=SHPTOT(2,NPOI,IGAU)
  922. SHPWRK(3,NPOI)=SHPTOT(3,NPOI,IGAU)
  923. 10 CONTINUE
  924. CALL JACOBI(XEL,SHPWRK,2,3,DJAC)
  925. CALL ROTB(BGENE,NSTRS,COSA,SINA)
  926. ELSE
  927. C
  928. C TERMES DE LA MATRICE DE RIGIDITE RELATIFS
  929. C AUX CISAILLEMENTS TRANSVERSES
  930. C
  931. CALL RCDST(XEL,NSTRS,LRE,DDHOMU,
  932. 1 WORK(1),WORK(10),WORK(19),REL,BGENE,1)
  933. C
  934. C TERMES DE LA MATRICE B RELATIFS AUX EFFETS
  935. C DE MEMBRANE ET DE FLEXION
  936. C
  937. CALL BMFDST(IGAU,XEL,NSTRS,QSIGAU,ETAGAU,SHPTOT,SHPWRK,
  938. 1 WORK(1),WORK(10),WORK(19),BGENE,DJAC)
  939. ENDIF
  940. DJAC=DJAC*POIGAU(IGAU)
  941. C
  942. C ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT
  943. C
  944. IF (EXCEN.NE.0.) THEN
  945. DO 1593 IJL=1,3
  946. DO 1593 IJC=1,LRE
  947. BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  948. 1593 CONTINUE
  949. ENDIF
  950. C
  951. CALL BDBS1(BGENE,DJAC,DDHOMU,LRE,NSTRS,REL,MFR,IFOUR,MATE,
  952. 1 IGAU,IMAT,EXCEN)
  953. 1193 CONTINUE
  954. REL(6,6)=REL(5,5)*1.D-7
  955. REL(12,12)=REL(6,6)
  956. REL(18,18)=REL(6,6)
  957. ICOM=0
  958. IF(ABS(EXCEN).GT.XPETIT .OR. CMATE.EQ.'COMPOSIT'
  959. 1 .OR. IMAT.EQ.2) ICOM=1
  960. CALL TRANSK(REL,BPSS,LRE,3,ICOM)
  961. C
  962. C REMPLISSAGE DE XMATRI
  963. C
  964. CALL REMPMT(REL,LRE,RE(1,1,IB))
  965. 3093 CONTINUE
  966. C
  967. 9993 CONTINUE
  968. SEGSUP WRK1,WRK2,WRK3,WRK4
  969. GOTO 510
  970. *
  971. C=======================================================================
  972. C========= ERREUR : CAS NON PREVUS =====================================
  973. C=======================================================================
  974. 99 CONTINUE
  975. MOTERR(1:4)=NOMTP(MELE)
  976. MOTERR(9:12)='RIGI3'
  977. CALL ERREUR(86)
  978. *
  979. 510 CONTINUE
  980. SEGSUP,MVELCH
  981. * SEGDES XMATRI
  982.  
  983. RETURN
  984. END
  985.  
  986.  
  987.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales