Télécharger epsi3.eso

Retour à la liste

Numérotation des lignes :

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

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