Télécharger epsi3.eso

Retour à la liste

Numérotation des lignes :

  1. C EPSI3 SOURCE FANDEUR 16/01/07 21:15:12 8756
  2. SUBROUTINE EPSI3(IPMAIL,IVADEP,IVACAR,NELMAT,NBGMAT,IVECT,
  3. & IVAMAT,LHOOK,IMAT,MATE,CMATE,NMATT,NSTRS,MFR,IPMINT,
  4. & NCARR,NDEP,NBPGAU,NBPTEL,MELE,LRE,LW,IREPS2,IVAEPS,
  5. & IPMIN1,UZDPG,RYDPG,RXDPG,NPINT,IIPDPG)
  6. C---------------------------------------------------------------------*
  7. C *
  8. C CALCUL DES DEFORMATIONS *
  9. C *
  10. C poutres,tuyaux,coq3,dkt,coq4,coq8,coq2 ,dst,joint 3D,joints 2D *
  11. C *
  12. C---------------------------------------------------------------------*
  13. C *
  14. C ENTREES : *
  15. C ________ *
  16. C *
  17. C IPMAIL Pointeur sur un segment MELEME *
  18. C IVADEP Pointeur sur le chamelem de deplacements *
  19. C IVACAR Pointeur sur les chamelems de caracteristiques *
  20. C NELMAT Taille maxi des melval du materiau (No d'element) *
  21. C NBGMAT Taille maxi des melval du materiau (pt de gauss) *
  22. C IVAMAT Pointeur sur un segment MPTVAL pour le materiau ou *
  23. C LHOOK Dimension de la matrice de Hooke *
  24. C IMAT (2 il y a une matrice de HOOKE,1 non ) *
  25. C MATE Numero du materiau *
  26. C CMATE Nom du materiau *
  27. C NMATT Nombre de composante de materiau (IMAT=1) *
  28. C NSTRS Nombre de composante de contraintes/deformations *
  29. C pour une matrice de hooke *
  30. C MFR Numero de formulation de l'element fini *
  31. C IPMINT Pointeur sur un segment MINTE *
  32. C IPMIN1 Pointeur sur un segment MINTE *
  33. C NDEP Nombre de composantes de deplacements *
  34. C NBPGAU Nombre de point d'integration pour la rigidite *
  35. C NBPTEL Nombre de points par element *
  36. C MELE Numero de l'element fini *
  37. C LRE Nombre de ddl dans la matrice de rigidite *
  38. C LW Dimension du tableau de travail de l'element *
  39. C IRESP2 Flag pour indiquer si on veut les contraintes *
  40. C de Piola-Kirchhoff *
  41. C dans le cas des elements de coque integres *
  42. C *
  43. C SORTIES : *
  44. C ________ *
  45. C *
  46. C IVAEPS pointeur sur un segment MPTVAL contenant les *
  47. C les melvals de déformations
  48. C *
  49. C---------------------------------------------------------------------*
  50. IMPLICIT INTEGER(I-N)
  51. IMPLICIT REAL*8(A-H,O-Z)
  52. C
  53. -INC CCOPTIO
  54. -INC CCHAMP
  55. -INC SMCHAML
  56. -INC SMCHPOI
  57. -INC SMELEME
  58. -INC SMCOORD
  59. -INC SMMODEL
  60. -INC SMINTE
  61. -INC SMLREEL
  62. C
  63. SEGMENT WRK1
  64. REAL*8 DDHOOK(NSTRS,NSTRS) ,XDDL(LRE) ,XSTRS(NSTRS)
  65. REAL*8 XE(3,NBBB),DDHOMU(NSTRS,NSTRS)
  66. ENDSEGMENT
  67. C
  68. SEGMENT WRK2
  69. REAL*8 SHPWRK(6,NBNO) ,BGENE(LHOOK,LRE)
  70. ENDSEGMENT
  71. C
  72. SEGMENT WRK3
  73. REAL*8 WORK(LW)
  74. ENDSEGMENT
  75. C
  76. SEGMENT WRK4
  77. REAL*8 BPSS(3,3) ,XEL(3,NBBB) ,XDDLOC(LRE)
  78. ENDSEGMENT
  79. C
  80. SEGMENT WRK5
  81. REAL*8 XSTRS1(NSTRS1)
  82. ENDSEGMENT
  83. segment wrk7
  84. real*8 out(30),propel(45),wk7d(1),wk7rel(1)
  85. endsegment
  86. C
  87. SEGMENT NOTYPE
  88. CHARACTER*16 TYPE(NBTYPE)
  89. ENDSEGMENT
  90. C
  91. SEGMENT MPTVAL
  92. INTEGER IPOS(NS),NSOF(NS)
  93. INTEGER IVAL(NCOSOU)
  94. CHARACTER*16 TYVAL(NCOSOU)
  95. ENDSEGMENT
  96. C
  97. SEGMENT,MVELCH
  98. REAL*8 VALMAT(NV1)
  99. ENDSEGMENT
  100. C
  101. CHARACTER*8 CMATE
  102. CHARACTER*(NCONCH) CONM
  103. PARAMETER (NINF=3)
  104. INTEGER INFOS(NINF)
  105. C
  106. C initialisation pour l'optimiseur
  107. MELVAL=0
  108.  
  109. C INITIALISATION DU POINT AUTOUR DUQUEL SE FAIT LE MOUVEMENT
  110. C DE LA SECTION EN DEFO PLANE GENERALISEE
  111. IF (IIPDPG.GT.0) THEN
  112. C <- test equivalent ici a IFOUR.EQ.-3
  113. C SEGACT MCOORD
  114. IREF=(IIPDPG-1)*(IDIM+1)
  115. XDPGE=XCOOR(IREF+1)
  116. YDPGE=XCOOR(IREF+2)
  117. ELSE
  118. XDPGE=0.D0
  119. YDPGE=0.D0
  120. ENDIF
  121. C
  122. MELEME=IPMAIL
  123. NBNN=NUM(/1)
  124. NBELEM=NUM(/2)
  125. C
  126. NHRM=NIFOUR
  127. C
  128. MINTE=IPMINT
  129. NBBB=NBNN
  130. C_______________________________________________________________________
  131. C
  132. C NUMERO DES ETIQUETTES :
  133. C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  134. C DANS LA ZONE SPECIFIQUE A CHAQUE ELEMENT COMMENCANT PAR :
  135. C 5 CONTINUE
  136. C ELEMENT 5 ETIQUETTES 1005 2005 3005 4005 ...
  137. C 44 CONTINUE
  138. C ELEMENT 44 ETIQUETTES 1044 2044 3044 4044 ...
  139. C_______________________________________________________________________
  140. C
  141. GOTO(99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  142. 1 99,99,99,99,99,99,27,28,27,99,99,99,99,99,99,99,99,99,99,99,
  143. 2 41,27,99,44,99,99,99,99,49,99,99,99,99,99,99,41,99,99,99,99,
  144. 3 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  145. 4 99,99,99,27,85,86,87,88,99,99,99,99,93,99,99,99,99),MELE
  146. C
  147. GOTO(168,169,170,171,172),MELE-167
  148. if(mele.eq.260) go to 260
  149. C
  150. GOTO 99
  151. C_______________________________________________________________________
  152. C ELEMENT SHB8
  153. C_______________________________________________________________________
  154. 260 continue
  155. SEGINI WRK1,WRK7
  156. DO 3260 IB=1,NBELEM
  157. C
  158. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  159. C
  160. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  161. C
  162. C ON CHERCHE LES DEPLACEMENTS
  163. C
  164. IE=1
  165. MPTVAL=IVADEP
  166. DO 4260 IGAU=1,NBNN
  167. DO 4260 ICOMP=1,NDEP
  168. MELVAL=IVAL(ICOMP)
  169. IGMN=MIN(IGAU,VELCHE(/1))
  170. IBMN=MIN(IB ,VELCHE(/2))
  171. XDDL(IE)=VELCHE(IGMN,IBMN)
  172. IE=IE+1
  173. 4260 CONTINUE
  174. propel(1)=1
  175. propel(2)=0.3
  176. propel(3)=ireps2
  177. call shb8(11,xe,wk7d,propel,xddl,wk7rel,out)
  178.  
  179. C REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  180. C
  181. MPTVAL=IVAEPS
  182. IE=1
  183. DO 7260 IGAU=1,NBPTEL
  184. DO 7260 ICOMP=1,NSTRS
  185. MELVAL=IVAL(ICOMP)
  186. IBMN=MIN(IB ,VELCHE(/2))
  187. VELCHE(IGAU,IBMN)=out(IE)
  188. IE=IE+1
  189. 7260 CONTINUE
  190. C
  191. 3260 CONTINUE
  192. SEGSUP WRK1,WRK7
  193. GOTO 510
  194. C
  195. C_______________________________________________________________________
  196. C
  197. C ELEMENTS COQ3 POUTRE ET TUYAU ET POUTRE TIMOSCHENKO
  198. C_______________________________________________________________________
  199. C
  200. 27 CONTINUE
  201. SEGINI WRK1,WRK3
  202. C
  203. C BOUCLE DE CALCUL POUR LES DIFFERENTS ELEMENTS
  204. C
  205. DO 3027 IB=1,NBELEM
  206. C
  207. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  208. C
  209. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  210. C
  211. C ON CHERCHE LES DEPLACEMENTS
  212. C
  213. MPTVAL=IVADEP
  214. IE=1
  215. DO 4027 IGAU=1,NBNN
  216. DO 4027 ICOMP=1,NDEP
  217. MELVAL=IVAL(ICOMP)
  218. IGMN=MIN(IGAU,VELCHE(/1))
  219. IBMN=MIN(IB ,VELCHE(/2))
  220. XDDL(IE)=VELCHE(IGMN,IBMN)
  221. IE=IE+1
  222. 4027 CONTINUE
  223. IF(MELE.EQ.29.OR.MELE.EQ.42.OR.MELE.EQ.84) GO TO 5029
  224. C CAS DES COQ3
  225. C
  226. C ON MET LA MATRICE DE HOOKE A L IDENTITE
  227. C
  228. CALL HOOKID(DDHOOK,NSTRS)
  229. CALL COQ3ST(XE,XDDL,XSTRS,DDHOOK)
  230. C
  231. IF(IREPS2.EQ.1)
  232. 1 CALL DBCO32(XE,DDHOOK,XDDL,WORK,XSTRS)
  233. C
  234. MPTVAL=IVAEPS
  235. DO 6027 ICOMP=1,NSTRS
  236. MELVAL=IVAL(ICOMP)
  237. IBMN=MIN(IB,VELCHE(/2))
  238. VELCHE(1,IBMN)=XSTRS(ICOMP)
  239. 6027 CONTINUE
  240. C
  241. GOTO 3027
  242. C
  243. C CAS DES POUTRES ET DES TUYAUX
  244. C ON STOCKE DES CARACTERISTIQUES GEOMETRIQUES DANS WORK
  245. C
  246. 5029 CONTINUE
  247. C
  248. C pour les poutres et tuyaux on cherche le module d'young et nu si
  249. C section reduite
  250. If( mele.eq.29.or.mele.eq.42) then
  251. mptval = ivamat
  252. segact mptval
  253. do itc=1,2
  254. melval=ival(itc)
  255. IGMN=MIN(IGAU,VELCHE(/1))
  256. ibmn= MIN(IB,VELCHE(/2))
  257. xaa=VELCHE(IGMN,IBMN)
  258. if(itc.eq.1) then
  259. youtc=xaa
  260. else
  261. xnutc=xaa
  262. endif
  263. enddo
  264. endif
  265.  
  266. C
  267. C ON CHERCHE LES CARACTERISTIQUES DE L ELEMENT IB
  268. C
  269. CALL ZERO(WORK,NCARR,1)
  270. DO 4029 IGAU=1,NBNN
  271. MPTVAL=IVACAR
  272. DO 6029 IC=1,NCARR
  273. IF(IVAL(IC).NE.0) THEN
  274. MELVAL=IVAL(IC)
  275. IBMN=MIN(IB,VELCHE(/2))
  276. IGMN=MIN(IGAU,VELCHE(/1))
  277. IF(IGMN.GT.0.AND.IBMN.GT.0) THEN
  278. WORK(IC)=WORK(IC)+VELCHE(IGMN,IBMN)
  279. ELSE
  280. WORK(IC)=0.
  281. ENDIF
  282. ELSE
  283. WORK(IC)=0.
  284. ENDIF
  285. IF (IGAU.EQ.NBNN) WORK(IC)=WORK(IC)/NBNN
  286. 6029 CONTINUE
  287. 4029 CONTINUE
  288. C
  289. C CAS OU ON A LU LE MOT VECTEUR
  290. C
  291. IF (IFOUR.EQ.2) THEN
  292. C
  293. IF (IVECT.EQ.1) THEN
  294. IF (IVAL(NCARR).NE.0) THEN
  295. MELVAL=IVAL(NCARR)
  296. IBMN=MIN(IB,IELCHE(/2))
  297. IP=IELCHE(1,IBMN)
  298. IREF=(IP-1)*(IDIM+1)
  299. DO 6129 IC=1,IDIM
  300. WORK(NCARR+IC-1)=XCOOR(IREF+IC)
  301. 6129 CONTINUE
  302. ELSE
  303. DO 6229 IC=1,IDIM
  304. WORK(NCARR+IC-1)=0.D0
  305. 6229 CONTINUE
  306. ENDIF
  307. ENDIF
  308. C
  309. ENDIF
  310. C
  311. C CAS DES TUYAUX - ON CALCULE LES CARACTERISTIQUES DE LA POUTRE
  312. C EQUIVALENTE
  313. IF(MELE.EQ.42) THEN
  314. CISA=WORK(4)
  315. VX=WORK(5)
  316. VY=WORK(6)
  317. VZ=WORK(7)
  318. CALL TUYCAR(WORK,CISA,VX,VY,VZ,KERRE,2)
  319. ENDIF
  320. C
  321. C ON CALCULE LES DEFORMATIONS
  322. C
  323. IF(MELE.EQ.84) THEN
  324. C
  325. IF(CMATE.EQ.'SECTION') THEN
  326. IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  327. CALL TIMEP2(XE,XDDL,WORK(12),WORK(25),IREPS2)
  328. ELSE
  329. CALL TIMEPS(XE,XDDL,WORK(1),WORK(12),WORK(25),IREPS2)
  330. ENDIF
  331. ELSE
  332. C
  333. IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  334. CALL TIMEP2(XE,XDDL,WORK(12),WORK(25),IREPS2)
  335. C
  336. ELSE
  337. CALL TIMEPS(XE,XDDL,WORK(7),WORK(12),WORK(25),IREPS2)
  338. ENDIF
  339. ENDIF
  340. ELSE
  341. C
  342. IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  343. CALL POUEP2(XE,XDDL,WORK,WORK(12),WORK(25),IREPS2
  344. $ ,youtc,xnutc)
  345. ELSE
  346. C
  347. CALL POUEPS(XE,XDDL,WORK,WORK(12),WORK(25),IREPS2
  348. $ , youtc,xnutc)
  349. ENDIF
  350. ENDIF
  351. C
  352. C REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  353. C
  354. ID=12
  355. C
  356. MPTVAL=IVAEPS
  357. DO 7029 IGAU=1,NBPTEL
  358. DO 7029 ICOMP=1,NSTRS
  359. MELVAL=IVAL(ICOMP)
  360. IBMN=MIN(IB ,VELCHE(/2))
  361. VELCHE(IGAU,IBMN)=WORK(ID)
  362. ID=ID+1
  363. 7029 CONTINUE
  364. C
  365. 3027 CONTINUE
  366. SEGSUP WRK1,WRK3
  367. GOTO 510
  368. C_______________________________________________________________________
  369. C
  370. C ELEMENT DKT
  371. C_______________________________________________________________________
  372. C
  373. 28 CONTINUE
  374. NBNO=NBNN
  375. SEGINI WRK1,WRK2,WRK4
  376. IF(NPINT.NE.0)THEN
  377. NSTRS1=6
  378. SEGINI WRK5
  379. ENDIF
  380. DO 3028 IB=1,NBELEM
  381. C
  382. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  383. C
  384. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  385. C
  386. C ON CHERCHE LES DEPLACEMENTS
  387. C
  388. IE=1
  389. DO 4028 IGAU=1,NBNN
  390. MPTVAL=IVADEP
  391. DO 4028 ICOMP=1,NDEP
  392. MELVAL=IVAL(ICOMP)
  393. IGMN=MIN(IGAU,VELCHE(/1))
  394. IBMN=MIN(IB ,VELCHE(/2))
  395. XDDL(IE)=VELCHE(IGMN,IBMN)
  396. IE=IE+1
  397. 4028 CONTINUE
  398. C
  399. C ON CHERCHE L EPAISSEUR ET L EXCENTREMENT
  400. C
  401. MPTVAL=IVACAR
  402. IF (IVAL(1).NE.0) THEN
  403. MELVAL=IVAL(1)
  404. IBMN=MIN(IB,VELCHE(/2))
  405. EPAIST=VELCHE(1,IBMN)
  406. ELSE
  407. EPAIST=0.D0
  408. ENDIF
  409. C
  410. IF (IVAL(2).NE.0) THEN
  411. MELVAL=IVAL(2)
  412. IBMN=MIN(IB,VELCHE(/2))
  413. EXCEN=VELCHE(1,IBMN)
  414. ELSE
  415. EXCEN=0.D0
  416. ENDIF
  417. C
  418. CALL VPAST(XE,BPSS)
  419. C BPSS STOCKE LA MATRICE DE PASSAGE
  420. CALL VCORLC (XE,XEL,BPSS)
  421. CALL MATVEC(XDDL,XDDLOC,BPSS,6)
  422. C
  423. IF(NPINT.EQ.0)THEN
  424. C
  425. C COQUE GLOBAL
  426. C
  427. C BOUCLE SUR LES POINTS DE GAUSS
  428. C
  429. DO 5028 IGAU=1,NBPTEL
  430. CALL BMAT28(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU,
  431. & MELE,MFR,NBNO,LRE,IFOUR,NSTRS,0,1.D0,XEL,
  432. & SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  433. C
  434. C ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT
  435. C
  436. IF (EXCEN.NE.0.) THEN
  437. DO 1528 IJL=1,3
  438. DO 1528 IJC=1,LRE
  439. BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  440. 1528 CONTINUE
  441. ENDIF
  442. C
  443. CALL BST(BGENE,XDDLOC,LRE,NSTRS,XSTRS)
  444. C
  445. C CALCUL DES EPS 2
  446. C
  447. IF(IREPS2.EQ.1)
  448. 1 CALL BDKT2(XEL,XDDLOC,IGAU,BGENE,XSTRS)
  449. C
  450. C RMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  451. C
  452. MPTVAL=IVAEPS
  453. DO 9028 ICOMP=1,NSTRS
  454. MELVAL=IVAL(ICOMP)
  455. IGMN=MIN(IGAU,VELCHE(/1))
  456. IBMN=MIN(IB ,VELCHE(/2))
  457. VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  458. 9028 CONTINUE
  459. 5028 CONTINUE
  460. C
  461. ELSE
  462. C
  463. C COQUE INTEGREE
  464. C
  465. NBPGA1=NBPGAU/NPINT
  466. C
  467. C BOUCLE SUR LES POINTS DE GAUSS DE LA SURFACE
  468. C
  469. DO 5001 IGAU=1,NBPGA1
  470. CALL BMAT28(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU,
  471. & MELE,MFR,NBNO,LRE,IFOUR,NSTRS1,0,1.D0,XEL,
  472. & SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  473. C
  474. C ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT
  475. C
  476. IF (EXCEN.NE.0.) THEN
  477. DO 1501 IJL=1,3
  478. DO 1501 IJC=1,LRE
  479. BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  480. 1501 CONTINUE
  481. ENDIF
  482. C
  483. C BOUCLE SUR LES NAPPES
  484. C
  485. DO 5002 INAP=1,NPINT
  486. IGAU1=(INAP-1)*NBPGA1+IGAU
  487. C
  488. CALL BST(BGENE,XDDLOC,LRE,NSTRS1,XSTRS1)
  489. C
  490. C CALCUL DES EPS 2
  491. C
  492. IF(IREPS2.EQ.1)
  493. 1 CALL BDKT2(XEL,XDDLOC,IGAU,BGENE,XSTRS1)
  494. C
  495. ZZZ=DZEGAU(IGAU1)*(EPAIST/2.D0)
  496. XSTRS(1)=XSTRS1(1)+ZZZ*XSTRS1(4)
  497. XSTRS(2)=XSTRS1(2)+ZZZ*XSTRS1(5)
  498. XSTRS(3)=0.D0
  499. XSTRS(4)=XSTRS1(3)+ZZZ*XSTRS1(6)
  500. C
  501. C REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  502. C
  503. MPTVAL=IVAEPS
  504. DO 9001 ICOMP=1,NSTRS
  505. MELVAL=IVAL(ICOMP)
  506. IBMN=MIN(IB ,VELCHE(/2))
  507. VELCHE(IGAU1,IBMN)=XSTRS(ICOMP)
  508. 9001 CONTINUE
  509. C
  510. C FIN DE BOUCLE SUR LES NAPPES DE POINTS
  511. 5002 CONTINUE
  512. C FIN DE BOUCLE SUR LES POINTS DANS CHAQUE NAPPE
  513. 5001 CONTINUE
  514. C FIN DE BOUCLE SUR LES POINTS D'INTEGRATION
  515. ENDIF
  516. C FIN DE BOUCLE SUR LES ELEMENTS
  517. 3028 CONTINUE
  518. SEGSUP WRK1,WRK2,WRK4
  519. IF(NPINT.NE.0) SEGSUP WRK5
  520. C
  521. GOTO 510
  522. C_______________________________________________________________________
  523. C
  524. C ELEMENTS COQ8 ET COQ6
  525. C_______________________________________________________________________
  526. C
  527. 41 CONTINUE
  528. SEGINI WRK1,WRK3
  529. MINTE1=IPMIN1
  530. SEGACT MINTE1
  531. NBPGA1=MINTE1.SHPTOT(/3)
  532. C NBN1 =MINTE1.SHPTOT(/2)
  533. C
  534. C BOUCLE DE CALCUL POUR LES DIFFERENTS ELEMENTS
  535. C
  536. DO 3041 IB=1,NBELEM
  537. C
  538. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  539. C
  540. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  541. C
  542. C ON CHERCHE LES DEPLACEMENTS
  543. C
  544. IE=1
  545. DO 4041 IGAU=1,NBNN
  546. MPTVAL=IVADEP
  547. DO 4041 ICOMP=1,NDEP
  548. MELVAL=IVAL(ICOMP)
  549. IGMN=MIN(IGAU,VELCHE(/1))
  550. IBMN=MIN(IB ,VELCHE(/2))
  551. XDDL(IE)=VELCHE(IGMN,IBMN)
  552. IE=IE+1
  553. 4041 CONTINUE
  554. C
  555. C ON CHERCHE LES EPAISSEURS ET LES EXCENTREMENTS,
  556. C ON LES MOYENNE SUR L'ELEMENT.
  557. C
  558. MPTVAL=IVACAR
  559. MELVAL=IVAL(1)
  560. EPAIST=0.D0
  561. IF (MELVAL.NE.0) THEN
  562. DO IGAU=1,NBPGAU
  563. IGMN=MIN(IGAU,VELCHE(/1))
  564. IBMN=MIN(IB ,VELCHE(/2))
  565. EPAIST=EPAIST+VELCHE(IGMN,IBMN)
  566. ENDDO
  567. EPAIST=EPAIST/NBPGAU
  568. ENDIF
  569. C
  570. MELVAL=IVAL(2)
  571. EXCEN=0.D0
  572. IF (MELVAL.NE.0) THEN
  573. DO IGAU=1,NBPGAU
  574. IGMN=MIN(IGAU,VELCHE(/1))
  575. IBMN=MIN(IB ,VELCHE(/2))
  576. EXCEN=EXCEN+VELCHE(IGMN,IBMN)
  577. ENDDO
  578. EXCEN=EXCEN/NBPGAU
  579. ENDIF
  580. C
  581. C ON CALCULE LES DEFORMATIONS
  582. C
  583. CALL COQ8EP(XE,NBNN,NBPGAU,LRE,NSTRS,EPAIST,EXCEN,
  584. 1 DZEGAU,SHPTOT,MINTE1.SHPTOT,XDDL,WORK,IRR)
  585. C
  586. C ON REMPLIT LES DEFORMATIONS
  587. C
  588. MPTVAL=IVAEPS
  589. IE=1
  590. DO 6041 IGAU=1,NBPGAU
  591. DO 6041 ICOMP=1,NSTRS
  592. MELVAL=IVAL(ICOMP)
  593. IBMN=MIN(IB ,VELCHE(/2))
  594. VELCHE(IGAU,IBMN)=WORK(IE)
  595. IE=IE+1
  596. 6041 CONTINUE
  597. C
  598. 3041 CONTINUE
  599. SEGSUP WRK1,WRK3
  600. GOTO 510
  601. C_______________________________________________________________________
  602. C
  603. C ELEMENT COQ2
  604. C_______________________________________________________________________
  605. C
  606. 44 CONTINUE
  607. NBNO=NBNN
  608. SEGINI WRK1,WRK2
  609. C
  610. NDDD=NDEP
  611. IF (IFOUR.EQ.-3) NDDD=NDEP-3
  612. DO 3044 IB=1,NBELEM
  613. C
  614. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IB
  615. C
  616. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  617. C
  618. C ON CHERCHE LES DEPLACEMENTS
  619. C
  620. MPTVAL=IVADEP
  621. IE=1
  622. DO 2044 IGAU=1,NBNN
  623. DO 2044 ICOMP=1,NDDD
  624. MELVAL=IVAL(ICOMP)
  625. IGMN=MIN(IGAU,VELCHE(/1))
  626. IBMN=MIN(IB ,VELCHE(/2))
  627. XDDL(IE)=VELCHE(IGMN,IBMN)
  628. IE=IE+1
  629. 2044 CONTINUE
  630. IF (IFOUR.EQ.-3) THEN
  631. XDDL(IE)=UZDPG
  632. XDDL(IE+1)=RYDPG
  633. XDDL(IE+2)=RXDPG
  634. ENDIF
  635. C
  636. C BOUCLE SUR LES POINTS DE GAUSS
  637. C
  638. DO 4044 IGAU=1,NBPGAU
  639. MPTVAL=IVACAR
  640. IF (IVAL(2).NE.0) THEN
  641. MELVAL=IVAL(2)
  642. IBMN=MIN(IB,VELCHE(/2))
  643. EXCEN=VELCHE(1,IBMN)
  644. ELSE
  645. EXCEN=0.D0
  646. ENDIF
  647. C APPEL A BCOQ2
  648. C
  649. CALL BCOQ2(BGENE,NSTRS,DJAC,IGAU,IFOUR,XE,NHRM,QSIGAU,POIGAU,
  650. . EXCEN,1.D0,IRR,XDPGE,YDPGE)
  651. C
  652. C GESTION D'ERREUR
  653. C
  654. IF (IRR.EQ.1) THEN
  655. INTERR(1)=IB
  656. CALL ERREUR(255)
  657. GOTO 9944
  658. ELSE IF(IRR.EQ.2) THEN
  659. INTERR(1)=IB
  660. CALL ERREUR(256)
  661. GOTO 9944
  662. ENDIF
  663. C
  664. CALL BST(BGENE,XDDL,LRE,NSTRS,XSTRS)
  665.  
  666. IF(IREPS2.EQ.1)
  667. +call b2coq2(xstrs,nstrs,xddl,nbnn*ndep,xe,nbnn,QSIGAU,POIGAU,igau)
  668. C
  669. C REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  670. C
  671. MPTVAL=IVAEPS
  672. DO 9044 ICOMP=1,NSTRS
  673. MELVAL=IVAL(ICOMP)
  674. IGMN=MIN(IGAU,VELCHE(/1))
  675. IBMN=MIN(IB ,VELCHE(/2))
  676. VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  677. 9044 CONTINUE
  678. 4044 CONTINUE
  679. 3044 CONTINUE
  680. C
  681. 9944 CONTINUE
  682. SEGSUP WRK1,WRK2
  683. GOTO 510
  684. C_______________________________________________________________________
  685. C
  686. C ELEMENT COQ4
  687. C_______________________________________________________________________
  688. C
  689. 49 CONTINUE
  690. NBNO=NBNN
  691. SEGINI WRK1,WRK2,WRK4
  692. C
  693. DO 3049 IB=1,NBELEM
  694. C
  695. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IB
  696. C
  697. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  698. C
  699. CALL CQ4LOC(XE,XEL,BPSS,IERT,1)
  700. C IERT=1 NODI TROPPO VICINI
  701. IF (IERT.EQ.1) THEN
  702. INTERR(1)=IB
  703. CALL ERREUR(323)
  704. GOTO 9949
  705. ELSE IF(IERT.EQ.3) THEN
  706. IERT = 0
  707. NOPLAN = 1
  708. ELSE
  709. NOPLAN = 0
  710. END IF
  711. C
  712. C ON CHERCHE LES DEPLACEMENTS
  713. C
  714. IE=1
  715. DO 2049 IGAU=1,NBNN
  716. MPTVAL=IVADEP
  717. DO 2049 ICOMP=1,NDEP
  718. MELVAL=IVAL(ICOMP)
  719. IGMN=MIN(IGAU,VELCHE(/1))
  720. IBMN=MIN(IB ,VELCHE(/2))
  721. XDDL(IE)=VELCHE(IGMN,IBMN)
  722. IE=IE+1
  723. 2049 CONTINUE
  724. CALL MATVEC(XDDL,XDDLOC,BPSS,8)
  725. C
  726. C BOUCLE SUR LES POINTS DE GAUSS
  727. C
  728. MPTVAL=IVACAR
  729. MELVAL=IVAL(1)
  730. IF (MELVAL.NE.0) THEN
  731. IBMN=MIN(IB,VELCHE(/2))
  732. EPAIST=VELCHE(1,IBMN)
  733. ELSE
  734. EPAIST=0.D0
  735. ENDIF
  736. C
  737. MELVAL=IVAL(2)
  738. IF (MELVAL.NE.0) THEN
  739. IBMN=MIN(IB,VELCHE(/2))
  740. EXCEN=VELCHE(1,IBMN)
  741. ELSE
  742. EXCEN=0.D0
  743. ENDIF
  744. C
  745. DO 4049 IGAU=1,NBPGAU
  746. C
  747. if(cmate.eq.'ISOTROPE') then
  748. CALL BCOQ4
  749. & (IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,EXCEN,NOPLAN,IERT,1)
  750. else
  751. CALL BCOQ4O
  752. & (IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,EXCEN,NOPLAN,IERT,1)
  753. endif
  754. C IERT=1 JACOBIANO <= 0
  755. IF(IERT.EQ.1) THEN
  756. INTERR(1)=IB
  757. CALL ERREUR(321)
  758. GOTO 9949
  759. ENDIF
  760. C
  761. CALL BST(BGENE,XDDLOC,LRE,NSTRS,XSTRS)
  762. C
  763. C REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  764. C
  765. MPTVAL=IVAEPS
  766. DO 9049 ICOMP=1,NSTRS
  767. MELVAL=IVAL(ICOMP)
  768. IGMN=MIN(IGAU,VELCHE(/1))
  769. IBMN=MIN(IB ,VELCHE(/2))
  770. VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  771. 9049 CONTINUE
  772. 4049 CONTINUE
  773. 3049 CONTINUE
  774. C
  775. 9949 CONTINUE
  776. SEGSUP WRK1,WRK2,WRK4
  777. GOTO 510
  778. C_______________________________________________________________________
  779. C
  780. C ELEMENT JOINT (JOI2)
  781. C_______________________________________________________________________
  782. C
  783. 85 CONTINUE
  784. NBNO=NBNN
  785. SEGINI WRK1,WRK2,WRK4
  786. C
  787. DO 3085 IB=1,NBELEM
  788. C
  789. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IB
  790. C
  791. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  792. C
  793. CALL JO2LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  794. C
  795. C ON CHERCHE LES DEPLACEMENTS
  796. C
  797. MPTVAL=IVADEP
  798. IE=1
  799. DO 2085 IGAU=1,NBNN
  800. DO 2085 ICOMP=1,NDEP
  801. MELVAL=IVAL(ICOMP)
  802. IGMN=MIN(IGAU,VELCHE(/1))
  803. IBMN=MIN(IB ,VELCHE(/2))
  804. XDDL(IE)=VELCHE(IGMN,IBMN)
  805. IE=IE+1
  806. 2085 CONTINUE
  807. C
  808. C BOUCLE SUR LES POINTS DE GAUSS
  809. C
  810. DO 4085 IGAU=1,NBPGAU
  811. C
  812. CALL BJO2(IGAU,MFR,IFOUR,NIFOUR,XEL,BPSS,SHPTOT,SHPWRK,
  813. . BGENE,DJAC,IRRT)
  814. C IRRT.NE.0 JACOBIEN <= 0
  815. IF(IRRT.NE.0) THEN
  816. INTERR(1)=IB
  817. CALL ERREUR(612)
  818. GOTO 9985
  819. ENDIF
  820. C
  821. CALL BST(BGENE,XDDL,LRE,NSTRS,XSTRS)
  822. C
  823. C REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  824. C
  825. MPTVAL=IVAEPS
  826. DO 9085 ICOMP=1,NSTRS
  827. MELVAL=IVAL(ICOMP)
  828. IGMN=MIN(IGAU,VELCHE(/1))
  829. IBMN=MIN(IB ,VELCHE(/2))
  830. VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  831. 9085 CONTINUE
  832. 4085 CONTINUE
  833. 3085 CONTINUE
  834. C
  835. 9985 CONTINUE
  836. SEGSUP WRK1,WRK2,WRK4
  837. GOTO 510
  838. C_______________________________________________________________________
  839. C
  840. C ELEMENT JOINT (JGI2)
  841. C_______________________________________________________________________
  842. C
  843. 170 CONTINUE
  844. NBNO=NBNN
  845. SEGINI WRK1,WRK2,WRK4
  846. C
  847. NDDD=NDEP
  848. IF (IFOUR.EQ.-3) NDDD=NDEP-3
  849. C
  850. DO IB=1,NBELEM
  851. C
  852. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IB
  853. C
  854. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  855. C
  856. CALL JO2LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  857. C
  858. C ON CHERCHE LES DEPLACEMENTS
  859. C
  860. MPTVAL=IVADEP
  861. IE=1
  862. DO IGAU=1,NBNN
  863. DO ICOMP=1,NDDD
  864. MELVAL=IVAL(ICOMP)
  865. IGMN=MIN(IGAU,VELCHE(/1))
  866. IBMN=MIN(IB ,VELCHE(/2))
  867. XDDL(IE)=VELCHE(IGMN,IBMN)
  868. IE=IE+1
  869. ENDDO
  870. ENDDO
  871. IF (IFOUR.EQ.-3) THEN
  872. XDDL(IE)=UZDPG
  873. XDDL(IE+1)=RYDPG
  874. XDDL(IE+2)=RXDPG
  875. ENDIF
  876. C
  877. C BOUCLE SUR LES POINTS DE GAUSS
  878. C
  879. DO IGAU=1,NBPGAU
  880. C
  881. C ON CHERCHE L EPAISSEUR DU JOINT
  882. C
  883. EPAIST=0.D0
  884. MPTVAL=IVACAR
  885. MELVAL=IVAL(1)
  886. IF (MELVAL.NE.0) THEN
  887. IGMN=MIN(IGAU,VELCHE(/1))
  888. IBMN=MIN(IB,VELCHE(/2))
  889. EPAIST=VELCHE(IGMN,IBMN)
  890. ENDIF
  891. C
  892. CcPPj CALL BJO2GN(IGAU,MFR,IFOUR,NIFOUR,XEL,BPSS,SHPTOT,SHPWRK,
  893. CcPPj. EPAIST,BGENE,DJAC,XDPGE,YDPGE,IRRT)
  894. CALL BJO2GN(IGAU,MFR,IFOUR,NIFOUR,XE,XEL,BPSS,SHPTOT,SHPWRK,
  895. . EPAIST,BGENE,DJAC,XDPGE,YDPGE,IRRT)
  896. C IRRT.NE.0 JACOBIEN <= 0
  897. IF (IRRT.NE.0) THEN
  898. INTERR(1)=IB
  899. CALL ERREUR(612)
  900. GOTO 9970
  901. ENDIF
  902. C
  903. CALL BST(BGENE,XDDL,LRE,NSTRS,XSTRS)
  904. C
  905. C REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  906. C
  907. MPTVAL=IVAEPS
  908. DO ICOMP=1,NSTRS
  909. MELVAL=IVAL(ICOMP)
  910. IGMN=MIN(IGAU,VELCHE(/1))
  911. IBMN=MIN(IB ,VELCHE(/2))
  912. VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  913. ENDDO
  914. ENDDO
  915. ENDDO
  916. C
  917. 9970 CONTINUE
  918. SEGSUP WRK1,WRK2,WRK4
  919. GOTO 510
  920. C_______________________________________________________________________
  921. C
  922. C ELEMENT JOINT (JCT3) en 2D cisaillement
  923. C_______________________________________________________________________
  924. C
  925. 168 CONTINUE
  926. NBNO=NBNN
  927. SEGINI WRK1,WRK2,WRK4
  928. C# MC 03/11/97
  929. C MELVAL=???????
  930. C IF (CMATE.NE.'ISOTROPE') THEN
  931. C MPTVAL=IVECT
  932. C MELVAL=IVAL(1)
  933. C NBGCOS=VELCHE(/1)
  934. C ENDIF
  935. C
  936. DO IB=1,NBELEM
  937. C
  938. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IB
  939. C
  940. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  941. C
  942. CALL JT3LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  943. C
  944. C ON CHERCHE LES DEPLACEMENTS
  945. C
  946. IE=1
  947. MPTVAL=IVADEP
  948. DO IGAU=1,NBNN
  949. DO ICOMP=1,NDEP
  950. MELVAL=IVAL(ICOMP)
  951. IGMN=MIN(IGAU,VELCHE(/1))
  952. IBMN=MIN(IB ,VELCHE(/2))
  953. XDDL(IE)=VELCHE(IGMN,IBMN)
  954. IE=IE+1
  955. END DO
  956. END DO
  957. C
  958. C BOUCLE SUR LES POINTS DE GAUSS
  959. C
  960. DO IGAU=1,NBPGAU
  961. C
  962. CALL BJT3C(IGAU,MFR,IFOUR,NIFOUR,XEL,BPSS,SHPTOT,SHPWRK,
  963. . BGENE,DJAC,IRRT)
  964. C IRRT.NE.0 JACOBIEN <= 0
  965. IF(IRRT.NE.0) THEN
  966. INTERR(1)=IB
  967. GOTO 9968
  968. ENDIF
  969. C
  970. CALL BST(BGENE,XDDL,LRE,NSTRS,XSTRS)
  971. C
  972. C REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  973. C
  974. MPTVAL=IVAEPS
  975. DO ICOMP=1,NSTRS
  976. MELVAL=IVAL(ICOMP)
  977. IGMN=MIN(IGAU,VELCHE(/1))
  978. IBMN=MIN(IB ,VELCHE(/2))
  979. VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  980. END DO
  981. END DO
  982. END DO
  983. C
  984. 9968 CONTINUE
  985. SEGSUP WRK1,WRK2,WRK4
  986. GOTO 510
  987. C_______________________________________________________________________
  988. C
  989. C ELEMENT JOINT (JGT3) GENERALISE
  990. C_______________________________________________________________________
  991. C
  992. 171 CONTINUE
  993. NBNO=NBNN
  994. SEGINI WRK1,WRK2,WRK4
  995. C# MC 03/11/97
  996. C MELVAL=???????
  997. C IF (CMATE.NE.'ISOTROPE') THEN
  998. C MPTVAL=IVECT
  999. C MELVAL=IVAL(1)
  1000. C NBGCOS=VELCHE(/1)
  1001. C ENDIF
  1002. C
  1003. DO IB=1,NBELEM
  1004. C
  1005. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IB
  1006. C
  1007. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1008. C
  1009. CALL JT3LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  1010. C
  1011. C ON CHERCHE LES DEPLACEMENTS
  1012. C
  1013. MPTVAL=IVADEP
  1014. IE=1
  1015. DO IGAU=1,NBNN
  1016. DO ICOMP=1,NDEP
  1017. MELVAL=IVAL(ICOMP)
  1018. IGMN=MIN(IGAU,VELCHE(/1))
  1019. IBMN=MIN(IB ,VELCHE(/2))
  1020. XDDL(IE)=VELCHE(IGMN,IBMN)
  1021. IE=IE+1
  1022. END DO
  1023. END DO
  1024. C
  1025. C BOUCLE SUR LES POINTS DE GAUSS
  1026. C
  1027. DO IGAU=1,NBPGAU
  1028. C
  1029. C ON CHERCHE L'EPAISSEUR DU JOINT
  1030. C
  1031. EPAIST=0.D0
  1032. MPTVAL=IVACAR
  1033. MELVAL=IVAL(1)
  1034. IF (MELVAL.NE.0) THEN
  1035. IGMN=MIN(IGAU,VELCHE(/1))
  1036. IBMN=MIN(IB,VELCHE(/2))
  1037. EPAIST=VELCHE(IGMN,IBMN)
  1038. ENDIF
  1039. C
  1040. C ON CALCULE B
  1041. C
  1042. CcPPj CALL BJT3G(IGAU,MFR,IFOUR,NIFOUR,XEL,BPSS,SHPTOT,SHPWRK,
  1043. CALL BJT3G(IGAU,MFR,IFOUR,NIFOUR,XE,XEL,BPSS,SHPTOT,SHPWRK,
  1044. . EPAIST,BGENE,DJAC,IRRT)
  1045. C IRRT.NE.0 JACOBIEN <= 0
  1046. IF (IRRT.NE.0) THEN
  1047. INTERR(1)=IB
  1048. CALL ERREUR(611)
  1049. GOTO 9971
  1050. ENDIF
  1051. C
  1052. CALL BST(BGENE,XDDL,LRE,NSTRS,XSTRS)
  1053. C
  1054. C REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  1055. C
  1056. MPTVAL=IVAEPS
  1057. DO ICOMP=1,NSTRS
  1058. MELVAL=IVAL(ICOMP)
  1059. IGMN=MIN(IGAU,VELCHE(/1))
  1060. IBMN=MIN(IB ,VELCHE(/2))
  1061. VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1062. END DO
  1063. END DO
  1064. END DO
  1065. C
  1066. 9971 CONTINUE
  1067. SEGSUP WRK1,WRK2,WRK4
  1068. GOTO 510
  1069. C_______________________________________________________________________
  1070. C
  1071. C ELEMENT JOINT (JCI4) en 2D cisaillement
  1072. C_______________________________________________________________________
  1073. C
  1074. 169 CONTINUE
  1075. NBNO=NBNN
  1076. SEGINI WRK1,WRK2,WRK4
  1077. C# MC 03/11/97
  1078. C MELVAL=???????
  1079. C IF (CMATE.NE.'ISOTROPE') THEN
  1080. C MPTVAL=IVECT
  1081. C MELVAL=IVAL(1)
  1082. C NBGCOS=VELCHE(/1)
  1083. C ENDIF
  1084. C
  1085. DO IB=1,NBELEM
  1086. C
  1087. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IB
  1088. C
  1089. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1090. C
  1091. CALL JO4LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  1092. C
  1093. C ON CHERCHE LES DEPLACEMENTS
  1094. C
  1095. MPTVAL=IVADEP
  1096. IE=1
  1097. DO IGAU=1,NBNN
  1098. DO ICOMP=1,NDEP
  1099. MELVAL=IVAL(ICOMP)
  1100. IGMN=MIN(IGAU,VELCHE(/1))
  1101. IBMN=MIN(IB ,VELCHE(/2))
  1102. XDDL(IE)=VELCHE(IGMN,IBMN)
  1103. IE=IE+1
  1104. ENDDO
  1105. ENDDO
  1106. C
  1107. C BOUCLE SUR LES POINTS DE GAUSS
  1108. C
  1109. DO IGAU=1,NBPGAU
  1110. C
  1111. CALL BJO4C(IGAU,XEL,BPSS,SHPTOT,SHPWRK,BGENE,DJAC,IRRT)
  1112. C IRRT.NE.0 JACOBIEN <= 0
  1113. IF(IRRT.NE.0) THEN
  1114. INTERR(1)=IB
  1115. CALL ERREUR(611)
  1116. GOTO 9969
  1117. ENDIF
  1118. C
  1119. CALL BST(BGENE,XDDL,LRE,NSTRS,XSTRS)
  1120. C
  1121. C REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  1122. C
  1123. MPTVAL=IVAEPS
  1124. DO ICOMP=1,NSTRS
  1125. MELVAL=IVAL(ICOMP)
  1126. IGMN=MIN(IGAU,VELCHE(/1))
  1127. IBMN=MIN(IB ,VELCHE(/2))
  1128. VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1129. ENDDO
  1130. ENDDO
  1131. ENDDO
  1132. C
  1133. 9969 CONTINUE
  1134. SEGSUP WRK1,WRK2,WRK4
  1135. GOTO 510
  1136. C_______________________________________________________________________
  1137. C
  1138. C ELEMENT JOINT (JGI4) GENERALISE
  1139. C_______________________________________________________________________
  1140. C
  1141. 172 CONTINUE
  1142. NBNO=NBNN
  1143. SEGINI WRK1,WRK2,WRK4
  1144. C# MC 03/11/97
  1145. C MELVAL=???????
  1146. C IF (CMATE.NE.'ISOTROPE') THEN
  1147. C MPTVAL=IVECT
  1148. C MELVAL=IVAL(1)
  1149. C NBGCOS=VELCHE(/1)
  1150. C ENDIF
  1151. C
  1152. DO IB=1,NBELEM
  1153. C
  1154. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IB
  1155. C
  1156. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1157. C
  1158. CALL JO4LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  1159. C
  1160. C ON CHERCHE LES DEPLACEMENTS
  1161. C
  1162. MPTVAL=IVADEP
  1163. IE=1
  1164. DO IGAU=1,NBNN
  1165. DO ICOMP=1,NDEP
  1166. MELVAL=IVAL(ICOMP)
  1167. IGMN=MIN(IGAU,VELCHE(/1))
  1168. IBMN=MIN(IB ,VELCHE(/2))
  1169. XDDL(IE)=VELCHE(IGMN,IBMN)
  1170. IE=IE+1
  1171. ENDDO
  1172. ENDDO
  1173. C
  1174. C BOUCLE SUR LES POINTS DE GAUSS
  1175. C
  1176. DO IGAU=1,NBPGAU
  1177. C
  1178. C ON CHERCHE L'EPAISSEUR DU JOINT
  1179. C
  1180. EPAIST=0.D0
  1181. MPTVAL=IVACAR
  1182. MELVAL=IVAL(1)
  1183. IF (MELVAL.NE.0) THEN
  1184. IGMN=MIN(IGAU,VELCHE(/1))
  1185. IBMN=MIN(IB,VELCHE(/2))
  1186. EPAIST=VELCHE(IGMN,IBMN)
  1187. ENDIF
  1188. C
  1189. CcPPj CALL BJO4G(IGAU,XEL,BPSS,SHPTOT,SHPWRK,EPAIST,
  1190. CALL BJO4G(IGAU,XE,XEL,BPSS,SHPTOT,SHPWRK,EPAIST,
  1191. > BGENE,DJAC,IRRT)
  1192. C IRRT.NE.0 JACOBIEN <= 0
  1193. IF (IRRT.NE.0) THEN
  1194. INTERR(1)=IB
  1195. CALL ERREUR(611)
  1196. GOTO 9972
  1197. ENDIF
  1198. C
  1199. CALL BST(BGENE,XDDL,LRE,NSTRS,XSTRS)
  1200. C
  1201. C REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  1202. C
  1203. MPTVAL=IVAEPS
  1204. DO ICOMP=1,NSTRS
  1205. MELVAL=IVAL(ICOMP)
  1206. IGMN=MIN(IGAU,VELCHE(/1))
  1207. IBMN=MIN(IB ,VELCHE(/2))
  1208. VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1209. ENDDO
  1210. ENDDO
  1211. ENDDO
  1212. C
  1213. 9972 CONTINUE
  1214. SEGSUP WRK1,WRK2,WRK4
  1215. GOTO 510
  1216.  
  1217. C_______________________________________________________________________
  1218. C
  1219. C ELEMENT JOINT (JOI3) IMPLEMENTATION SANS TEST DE PLANEITE
  1220. C ET SANS REPERE LOCAL
  1221. C_______________________________________________________________________
  1222. C
  1223. 86 CONTINUE
  1224. NBNO=NBNN
  1225. SEGINI WRK1,WRK2,WRK4
  1226. C
  1227. DO 3086 IB=1,NBELEM
  1228. C
  1229. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IB
  1230. C
  1231. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1232. C
  1233. C ON CHERCHE LES DEPLACEMENTS
  1234. C
  1235. MPTVAL=IVADEP
  1236. IE=1
  1237. DO 2086 IGAU=1,NBNN
  1238. DO 2086 ICOMP=1,NDEP
  1239. MELVAL=IVAL(ICOMP)
  1240. IGMN=MIN(IGAU,VELCHE(/1))
  1241. IBMN=MIN(IB ,VELCHE(/2))
  1242. XDDL(IE)=VELCHE(IGMN,IBMN)
  1243. IE=IE+1
  1244. 2086 CONTINUE
  1245. C
  1246. C BOUCLE SUR LES POINTS DE GAUSS
  1247. C
  1248. DO 4086 IGAU=1,NBPGAU
  1249. C
  1250. CALL JO3LOC(XE,SHPTOT,IGAU,NBNN,BPSS)
  1251. C
  1252. CALL BJO3(IGAU,MFR,IFOUR,NIFOUR,XE,BPSS,SHPTOT,SHPWRK,
  1253. . BGENE,DJAC,IRRT)
  1254. C IRRT.NE.0 JACOBIEN <= 0
  1255. IF (IRRT.NE.0) THEN
  1256. INTERR(1)=IB
  1257. CALL ERREUR(612)
  1258. GOTO 9986
  1259. ENDIF
  1260. C
  1261. CALL BST(BGENE,XDDL,LRE,NSTRS,XSTRS)
  1262. C
  1263. C REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  1264. C
  1265. MPTVAL=IVAEPS
  1266. DO 9086 ICOMP=1,NSTRS
  1267. MELVAL=IVAL(ICOMP)
  1268. IGMN=MIN(IGAU,VELCHE(/1))
  1269. IBMN=MIN(IB ,VELCHE(/2))
  1270. VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1271. 9086 CONTINUE
  1272. 4086 CONTINUE
  1273. 3086 CONTINUE
  1274. C
  1275. C IMPRESSION D'UN MESSAGE D'ERREUR
  1276. C
  1277. 9986 CONTINUE
  1278. SEGSUP WRK1,WRK2,WRK4
  1279. GOTO 510
  1280. C_______________________________________________________________________
  1281. C
  1282. C ELEMENT JOINT (JOT3)
  1283. C_______________________________________________________________________
  1284. C
  1285. 87 CONTINUE
  1286. NBNO=NBNN
  1287. SEGINI WRK1,WRK2,WRK4
  1288. C# MC 03/11/97
  1289. C MELVAL=???????
  1290. C IF (CMATE.NE.'ISOTROPE') THEN
  1291. C MPTVAL=IVECT
  1292. C MELVAL=IVAL(1)
  1293. C NBGCOS=VELCHE(/1)
  1294. C ENDIF
  1295. C
  1296. DO 3087 IB=1,NBELEM
  1297. C
  1298. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IB
  1299. C
  1300. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1301. C
  1302. CALL JT3LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  1303. C
  1304. C ON CHERCHE LES DEPLACEMENTS
  1305. C
  1306. MPTVAL=IVADEP
  1307. IE=1
  1308. DO 2087 IGAU=1,NBNN
  1309. DO 2087 ICOMP=1,NDEP
  1310. MELVAL=IVAL(ICOMP)
  1311. IGMN=MIN(IGAU,VELCHE(/1))
  1312. IBMN=MIN(IB ,VELCHE(/2))
  1313. XDDL(IE)=VELCHE(IGMN,IBMN)
  1314. IE=IE+1
  1315. 2087 CONTINUE
  1316. C
  1317. C BOUCLE SUR LES POINTS DE GAUSS
  1318. C
  1319. DO 4087 IGAU=1,NBPGAU
  1320. C
  1321. CALL BJT3(IGAU,MFR,IFOUR,NIFOUR,XEL,BPSS,SHPTOT,SHPWRK,
  1322. . BGENE,DJAC,IRRT)
  1323. C IRRT.NE.0 JACOBIEN <= 0
  1324. IF (IRRT.NE.0) THEN
  1325. INTERR(1)=IB
  1326. CALL ERREUR(611)
  1327. GOTO 9987
  1328. ENDIF
  1329. C
  1330. CALL BST(BGENE,XDDL,LRE,NSTRS,XSTRS)
  1331. C
  1332. C REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  1333. C
  1334. MPTVAL=IVAEPS
  1335. DO 9087 ICOMP=1,NSTRS
  1336. MELVAL=IVAL(ICOMP)
  1337. IGMN=MIN(IGAU,VELCHE(/1))
  1338. IBMN=MIN(IB ,VELCHE(/2))
  1339. VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1340. 9087 CONTINUE
  1341. 4087 CONTINUE
  1342. 3087 CONTINUE
  1343. C
  1344. 9987 CONTINUE
  1345. SEGSUP WRK1,WRK2,WRK4
  1346. GOTO 510
  1347. C_______________________________________________________________________
  1348. C
  1349. C ELEMENT JOINT (JOI4)
  1350. C_______________________________________________________________________
  1351. C
  1352. 88 CONTINUE
  1353. NBNO=NBNN
  1354. SEGINI WRK1,WRK2,WRK4
  1355. C# MC 03/11/97
  1356. C MELVAL=???????
  1357. C IF (CMATE.NE.'ISOTROPE') THEN
  1358. C MPTVAL=IVECT
  1359. C MELVAL=IVAL(1)
  1360. C NBGCOS=VELCHE(/1)
  1361. C ENDIF
  1362. C
  1363. DO 3088 IB=1,NBELEM
  1364. C
  1365. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IB
  1366. C
  1367. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1368. C
  1369. CALL JO4LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  1370. C
  1371. C ON CHERCHE LES DEPLACEMENTS
  1372. C
  1373. MPTVAL=IVADEP
  1374. IE=1
  1375. DO 2088 IGAU=1,NBNN
  1376. DO 2088 ICOMP=1,NDEP
  1377. MELVAL=IVAL(ICOMP)
  1378. IGMN=MIN(IGAU,VELCHE(/1))
  1379. IBMN=MIN(IB ,VELCHE(/2))
  1380. XDDL(IE)=VELCHE(IGMN,IBMN)
  1381. IE=IE+1
  1382. 2088 CONTINUE
  1383. C
  1384. C BOUCLE SUR LES POINTS DE GAUSS
  1385. C
  1386. DO 4088 IGAU=1,NBPGAU
  1387. C
  1388. CALL BJO4(IGAU,XEL,BPSS,SHPTOT,SHPWRK,BGENE,DJAC,IRRT)
  1389. C IRRT.NE.0 JACOBIEN <= 0
  1390. IF (IRRT.NE.0) THEN
  1391. INTERR(1)=IB
  1392. CALL ERREUR(611)
  1393. GOTO 9988
  1394. ENDIF
  1395. C
  1396. CALL BST(BGENE,XDDL,LRE,NSTRS,XSTRS)
  1397. C
  1398. C REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  1399. C
  1400. MPTVAL=IVAEPS
  1401. DO 9088 ICOMP=1,NSTRS
  1402. MELVAL=IVAL(ICOMP)
  1403. IGMN=MIN(IGAU,VELCHE(/1))
  1404. IBMN=MIN(IB ,VELCHE(/2))
  1405. VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1406. 9088 CONTINUE
  1407. 4088 CONTINUE
  1408. 3088 CONTINUE
  1409. C
  1410. 9988 CONTINUE
  1411. SEGSUP WRK1,WRK2,WRK4
  1412. GOTO 510
  1413. C_______________________________________________________________________
  1414. C
  1415. C ELEMENT DST
  1416. C_______________________________________________________________________
  1417. C
  1418. 93 CONTINUE
  1419. NBNO=NBNN
  1420. NV1=NMATT
  1421. SEGINI WRK1,WRK2,WRK3,WRK4,MVELCH
  1422. IF(CMATE.NE.'ISOTROPE')THEN
  1423. MPTVAL=IVAMAT
  1424. IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  1425. MELVAL=IVAL(7)
  1426. ELSE
  1427. MELVAL=IVAL(2)
  1428. ENDIF
  1429. NBGCOS=VELCHE(/1)
  1430. ENDIF
  1431. IRTD = 1
  1432. DO 3093 IB=1,NBELEM
  1433. C
  1434. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  1435. C
  1436. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1437. C
  1438. C ON CHERCHE LES DEPLACEMENTS
  1439. C
  1440. MPTVAL=IVADEP
  1441. IE=1
  1442. DO 4093 IGAU=1,NBNN
  1443. DO 4093 ICOMP=1,NDEP
  1444. MELVAL=IVAL(ICOMP)
  1445. IGMN=MIN(IGAU,VELCHE(/1))
  1446. IBMN=MIN(IB ,VELCHE(/2))
  1447. XDDL(IE)=VELCHE(IGMN,IBMN)
  1448. IE=IE+1
  1449. 4093 CONTINUE
  1450. CALL VPAST(XE,BPSS)
  1451. C BPSS STOCKE LA MATRICE DE PASSAGE
  1452. CALL VCORLC (XE,XEL,BPSS)
  1453. CALL MATVEC(XDDL,XDDLOC,BPSS,6)
  1454. C
  1455. C ON CHERCHE LES EPAISEURS ET ON LES MOYENNE,
  1456. C LES EXCENTREMENTS ET ON LES MOYENNE.
  1457. C
  1458. MPTVAL=IVACAR
  1459. EPAIST=0.D0
  1460. MELVAL=IVAL(1)
  1461. IF (MELVAL.NE.0) THEN
  1462. DO IGAU=1,NBPGAU
  1463. IGMN=MIN(IGAU,VELCHE(/1))
  1464. IBMN=MIN(IB,VELCHE(/2))
  1465. EPAIST=EPAIST+VELCHE(IGMN,IBMN)
  1466. ENDDO
  1467. EPAIST=EPAIST/NBPGAU
  1468. ENDIF
  1469. C
  1470. EXCEN=0.D0
  1471. MELVAL=IVAL(2)
  1472. IF (MELVAL.NE.0) THEN
  1473. DO IGAU=1,NBPGAU
  1474. IGMN=MIN(IGAU,VELCHE(/1))
  1475. IBMN=MIN(IB,VELCHE(/2))
  1476. EXCEN=EXCEN+VELCHE(IGMN,IBMN)
  1477. ENDDO
  1478. EXCEN=EXCEN/NBPGAU
  1479. ENDIF
  1480. C
  1481. C BOUCLE SUR LES POINTS DE GAUSS
  1482. C
  1483. DO 5093 IGAU=1,NBPTEL
  1484. C
  1485. C Dans le cas des matériaux orthotropes, les déformations sont d'abord
  1486. C calculées dans le repère d'orthotropie (les formules utilisées par les
  1487. C routines RCDST et BMFDST ne sont valables que dans ce repère); elles
  1488. C sont ensuite exprimées dans le repère local de l'élément.
  1489. C
  1490. C ON CHERCHE LA MATRICE DE HOOKE
  1491. C
  1492. MPTVAL=IVAMAT
  1493. IF(IMAT.EQ.2) THEN
  1494. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1495. MELVAL=IVAL(1)
  1496. IBMN=MIN(IB ,IELCHE(/2))
  1497. IGMN=MIN(IGAU,IELCHE(/1))
  1498. MLREEL=IELCHE(IGMN,IBMN)
  1499. SEGACT MLREEL
  1500. CALL DOHOOO(PROG,LHOOK,DDHOMU)
  1501. SEGDES MLREEL
  1502. ENDIF
  1503. ELSE IF (IMAT.EQ.1) THEN
  1504. DO 9193 IM=1,NMATT
  1505. IF (IVAL(IM).NE.0) THEN
  1506. MELVAL=IVAL(IM)
  1507. IBMN=MIN(IB ,VELCHE(/2))
  1508. IGMN=MIN(IGAU,VELCHE(/1))
  1509. VALMAT(IM)=VELCHE(IGMN,IBMN)
  1510. ELSE
  1511. VALMAT(IM)=0.D0
  1512. ENDIF
  1513. 9193 CONTINUE
  1514. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  1515. 1 CALL DOHDST(VALMAT,CMATE,IFOUR,NSTRS,DDHOOK,IRTD)
  1516. CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  1517. ENDIF
  1518. CALL ZERO(BGENE,NSTRS,LRE)
  1519. IF(CMATE.NE.'ISOTROPE')THEN
  1520. IF(IGAU.LE.NBGCOS)THEN
  1521. IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  1522. COSA=VALMAT(7)
  1523. SINA=VALMAT(8)
  1524. ELSE
  1525. MPTVAL=IVAMAT
  1526. MELVAL=IVAL(2)
  1527. IBMN=MIN(IB ,VELCHE(/2))
  1528. IGMN=MIN(IGAU,VELCHE(/1))
  1529. COSA=VELCHE(IGMN,IBMN)
  1530. MELVAL=IVAL(3)
  1531. IBMN=MIN(IB ,VELCHE(/2))
  1532. IGMN=MIN(IGAU,VELCHE(/1))
  1533. SINA=VELCHE(IGMN,IBMN)
  1534. ENDIF
  1535. DO 1393 INO=1,NBNN
  1536. XX=COSA*XEL(1,INO)+SINA*XEL(2,INO)
  1537. YY=(-SINA)*XEL(1,INO)+COSA*XEL(2,INO)
  1538. XE(1,INO)=XX
  1539. XE(2,INO)=YY
  1540. 1393 CONTINUE
  1541. ENDIF
  1542. C
  1543. C TERMES DE LA MATRICE DE RIGIDITE RELATIFS
  1544. C AUX CISAILLEMENTS TRANSVERSES
  1545. C
  1546. CALL RCDST(XE,NSTRS,LRE,DDHOMU,
  1547. 1 WORK(1),WORK(10),WORK(19),REL,BGENE,1)
  1548. C
  1549. C TERMES DE LA MATRICE B RELATIFS AUX EFFETS
  1550. C DE MEMBRANE ET DE FLEXION
  1551. C
  1552. CALL BMFDST(IGAU,XE,NSTRS,QSIGAU,ETAGAU,SHPTOT,SHPWRK,
  1553. 1 WORK(1),WORK(10),WORK(19),BGENE,DUM)
  1554. C
  1555. CALL ROTB(BGENE,NSTRS,COSA,SINA)
  1556. ELSE
  1557. C
  1558. C TERMES DE LA MATRICE B RELATIFS AUX CISAILLEMENTS TRANSVERSES
  1559. C
  1560. CALL RCDST(XEL,NSTRS,LRE,DDHOMU,
  1561. 1 WORK(1),WORK(10),WORK(19),REL,BGENE,1)
  1562. C
  1563. C TERMES DE LA MATRICE B RELATIFS AUX EFFETS
  1564. C DE MEMBRANE ET DE FLEXION
  1565. C
  1566. CALL BMFDST(IGAU,XEL,NSTRS,QSIGAU,ETAGAU,SHPTOT,SHPWRK,
  1567. 1 WORK(1),WORK(10),WORK(19),BGENE,DJAC)
  1568. ENDIF
  1569. C
  1570. C ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT
  1571. C
  1572. IF (EXCEN.NE.0.) THEN
  1573. DO 1593 IJL=1,3
  1574. DO 1593 IJC=1,LRE
  1575. BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  1576. 1593 CONTINUE
  1577. ENDIF
  1578. C
  1579. CALL BST(BGENE,XDDLOC,LRE,NSTRS,XSTRS)
  1580. C
  1581. C CALCUL DES EPS 2
  1582. C
  1583. IF(IREPS2.EQ.1)THEN
  1584. IF(CMATE.EQ.'ORTHOTRO')THEN
  1585. CALL BDST2(XE,XDDLOC,IGAU,BGENE,CMATE,COSA,SINA,XSTRS)
  1586. ELSE
  1587. CALL BDST2(XEL,XDDLOC,IGAU,BGENE,CMATE,COSA,SINA,XSTRS)
  1588. ENDIF
  1589. ENDIF
  1590. C
  1591. C CHANGEMENT DE REPERE: ORTHO -> LOCAL
  1592. C
  1593. IF(CMATE.EQ.'ORTHOTRO')
  1594. 1 CALL CHGREP2(COSA,SINA,XSTRS,0,0)
  1595. C
  1596. C RMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  1597. C
  1598. MPTVAL=IVAEPS
  1599. DO 9093 ICOMP=1,NSTRS
  1600. MELVAL=IVAL(ICOMP)
  1601. IGMN=MIN(IGAU,VELCHE(/1))
  1602. IBMN=MIN(IB ,VELCHE(/2))
  1603. VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1604. 9093 CONTINUE
  1605. 5093 CONTINUE
  1606. 3093 CONTINUE
  1607. C
  1608. C ERREUR LE MATERIAU PAS ENCORE IMPLEMENTER POUR
  1609. C LA FORMULATION MFR ET L OPTION IFOUR
  1610. IF (IRTD.EQ.0) THEN
  1611. MOTERR(1:8)=CMATE
  1612. MOTERR(9:12)=NOMFR(MFR/2+1)
  1613. INTERR(1)=IFOUR
  1614. CALL ERREUR(81)
  1615. ENDIF
  1616.  
  1617. SEGSUP WRK1,WRK2,WRK3,WRK4,MVELCH
  1618. GOTO 510
  1619. C____________________________________________________________________
  1620. 99 CONTINUE
  1621. MOTERR(1:4)=NOMTP(MELE)
  1622. MOTERR(9:12)='EPSI'
  1623. CALL ERREUR(86)
  1624. C
  1625. 510 CONTINUE
  1626. RETURN
  1627. END
  1628.  
  1629.  
  1630.  
  1631.  
  1632.  
  1633.  
  1634.  
  1635.  

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