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

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