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

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