Télécharger sigma1.eso

Retour à la liste

Numérotation des lignes :

  1. C SIGMA1 SOURCE PV 19/01/25 21:15:11 10085
  2.  
  3. SUBROUTINE SIGMA1(MATE,IMAT,IPMAIL,IPMINT,MELE,IELE,
  4. & IVADEP,NBPTEL,LRE,NSTRS,IVAMAT,NBGMAT,NELMAT,LHOOK,NMATT,
  5. & CMATE,MFR,NDEP,IPORE,IREPS2,NBPGAU,IVASTR,UZDPG,RYDPG,RXDPG,
  6. & IIPDPG,inoer)
  7.  
  8. *---------------------------------------------------------------------*
  9. * _________________________ *
  10. * | | *
  11. * | calcul des contraintes | *
  12. * |_________________________| *
  13. * *
  14. * massif, poreux, joints poreux, incompressibles *
  15. * *
  16. *---------------------------------------------------------------------*
  17. * *
  18. * entrees : *
  19. * ________ *
  20. * *
  21. * mate numero du materiau *
  22. * imat (2 il y a une matrice de hooke,1 non ) *
  23. * ipmail pointeur sur un segment meleme *
  24. * ipmint pointeur sur un segment minte *
  25. * mele numero de l'element fini *
  26. * iele numero geometrique de l'element
  27. * nbpgau nombre de point d'integration pour la rigidite *
  28. * ivadep pointeur sur le chamelem de deplacements *
  29. * nbptel nombre de points par element *
  30. * lre nombre de ddl dans la matrice de rigidite *
  31. * nstrs nombre de composante de contraintes/deformations *
  32. * ivamat pointeur sur un segment mptval pour le materiau ou *
  33. * pour une matrice de hooke *
  34. * nbgmat taille maxi des melval du materiau (pt de gauss) *
  35. * nelmat taille maxi des melval du materiau (no d'element) *
  36. * lhook dimension de la matrice de hooke *
  37. * nmatt nombre de composante de materiau (imat=1) *
  38. * cmate nom du materiau *
  39. * mfr numero de la formulation de l'element fini *
  40. * ndep nombre de composantes de deplacements *
  41. * ipore nombre de fonctions de forme *
  42. * iresp2 flag pour indiquer si on veut les contraintes *
  43. * de piola-kirchhoff *
  44. * uzdpg = deformation au point nsdpge support de la *
  45. * rydpf = deformation plane generalisee *
  46. * rxdpg = *
  47. * *
  48. * sorties : *
  49. * ________ *
  50. * *
  51. * ivastr pointeur sur un segment mptval contenant les *
  52. * les melvals de contraints
  53. * *
  54. *---------------------------------------------------------------------*
  55.  
  56. IMPLICIT INTEGER(I-N)
  57. IMPLICIT REAL*8(A-H,O-Z)
  58.  
  59. -INC CCOPTIO
  60. -INC CCHAMP
  61. -INC CCREEL
  62. -INC CCGEOME
  63. -INC SMCHAML
  64. -INC SMINTE
  65. -INC SMELEME
  66. -INC SMCOORD
  67. -INC SMLREEL
  68.  
  69. SEGMENT WRK1
  70. REAL*8 DDHOOK(LHOOK,LHOOK) ,XDDL(LRE) ,XSTRS(NSTRS)
  71. REAL*8 XE(3,NBBB) ,DDHOMU(LHOOK,LHOOK)
  72. ENDSEGMENT
  73. c
  74. SEGMENT WRK2
  75. REAL*8 SHPWRK(6,NBNO) ,BGENE(LHOOK,LRE)
  76. ENDSEGMENT
  77. c
  78. SEGMENT WRK3
  79. REAL*8 BPSS(3,3),XEL(3,NBBB)
  80. ENDSEGMENT
  81. c
  82. SEGMENT WRK5
  83. REAL*8 XGENE(NSTN,LRN),COBMA(LHOOK),XWRK(LHOOK)
  84. REAL*8 COBB(IDECAP),CPBB(IDECAP),KKBB(IDECAP,IDECAP)
  85. ENDSEGMENT
  86. c
  87. SEGMENT WRK8
  88. REAL*8 XLOC(3,3),XGLOB(3,3),TXR(IDIM,IDIM)
  89. REAL*8 D1HO(LHOOK,LHOOK),ROTH(LHOOK,LHOOK)
  90. ENDSEGMENT
  91. c
  92. SEGMENT,MVELCH
  93. REAL*8 VALMAT(NV1)
  94. ENDSEGMENT
  95. c
  96. SEGMENT MPTVAL
  97. INTEGER IPOS(NS) ,NSOF(NS)
  98. INTEGER IVAL(NCOSOU)
  99. CHARACTER*16 TYVAL(NCOSOU)
  100. ENDSEGMENT
  101. *
  102. SEGMENT MTRACE
  103. REAL*8 TRACE(3,NBPTEL)
  104. ENDSEGMENT
  105. *
  106. CHARACTER*8 CMATE
  107. DIMENSION A(4,60),BB(3,60),UDPGE(3),PP(4,4)
  108. LOGICAL BDPGE
  109.  
  110. c Introduction du point autour duquel se fait le mouvement
  111. c de la section en defo plane generalisee
  112. c Pas de rotation en 1D
  113. BDPGE=.FALSE.
  114. NDPGE=0
  115. XDPGE=XZero
  116. YDPGE=XZero
  117. IF (IFOUR.EQ.-3) THEN
  118. BDPGE=.TRUE.
  119. NDPGE=3
  120. UDPGE(1)=UZDPG
  121. UDPGE(2)=RYDPG
  122. UDPGE(3)=RXDPG
  123. SEGACT,MCOORD
  124. IREF=(IIPDPG-1)*(IDIM+1)
  125. XDPGE=XCOOR(IREF+1)
  126. YDPGE=XCOOR(IREF+2)
  127. ELSE IF (IDIM.EQ.1) THEN
  128. IF ((IFOUR.GE.7 .AND. IFOUR.LE.10) .OR. IFOUR.EQ.14) THEN
  129. BDPGE=.TRUE.
  130. NDPGE=1
  131. UDPGE(1)=UZDPG
  132. ELSE IF (IFOUR.EQ.11) THEN
  133. BDPGE=.TRUE.
  134. NDPGE=2
  135. UDPGE(1)=UZDPG
  136. UDPGE(2)=RXDPG
  137. ENDIF
  138. ENDIF
  139. *
  140. MELEME=IPMAIL
  141. NBNN=NUM(/1)
  142. NBELEM=NUM(/2)
  143. *
  144. IDECAP=0
  145. NHRM=NIFOUR
  146. *
  147. NV1=NMATT
  148. SEGINI,MVELCH
  149. *
  150. MINTE=IPMINT
  151. *
  152. NBBB=NBNN
  153. SEGINI WRK1
  154. *
  155. IRTD=1
  156. c_______________________________________________________________________
  157. c
  158. c numero des etiquettes :
  159. c etiquettes de 1 a 98 pour traitement specifique a l element
  160. c dans la zone specifique a chaque element commencant par :
  161. c 5 continue
  162. c element 5 etiquettes 1005 2005 3005 4005 ...
  163. c 44 continue
  164. c element 44 etiquettes 1044 2044 3044 4044 ...
  165. c_______________________________________________________________________
  166. c
  167. GOTO (99,99,99, 4,99, 4,99, 4,99, 4,99,99,99, 4, 4, 4, 4,99,99,99,
  168. 1 99,99, 4, 4, 4, 4,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  169. 2 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  170. 3 99,99,99,99,99,99,99,99, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,79,79,
  171. 4 79,79,79,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  172. 5 99,99,99,99,99,99,99,80,80,80, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
  173. 6 4, 4),MELE
  174. *
  175. IF (MELE.EQ.183.OR.MELE.EQ.184.OR.
  176. . MELE.EQ.193.OR.MELE.EQ.194) GOTO 4
  177. IF (MELE.GE.173.AND.MELE.LE.182) GOTO 173
  178. IF (MELE.GE.185.AND.MELE.LE.190) GOTO 185
  179. IF (MELE.EQ.273.OR.MELE.EQ.274) GOTO 4
  180. *
  181. GOTO 99
  182.  
  183. c_______________________________________________________________________
  184. c
  185. c elements massifs et elements incompressibles
  186. c_______________________________________________________________________
  187. c
  188. 4 CONTINUE
  189. c
  190. c Cas non isotropes :
  191. c Recuperation des fonctions de forme et leurs derivees au centre de
  192. c l'element pour le calcul des axes locaux
  193. c
  194. IPMIN2 = 0
  195. IF ( (MATE.EQ.2.OR.MATE.EQ.3.OR.MATE.EQ.4) .AND. IMAT.EQ.1 ) THEN
  196. NLG=NUMGEO(MELE)
  197. CALL RESHPT(1,NBNN,NLG,MELE,0,IPMIN2,IRT1)
  198. MINTE2=IPMIN2
  199. SEGACT,MINTE2
  200. SEGINI,WRK8
  201. ENDIF
  202. c
  203. NBNO=NBNN
  204. SEGINI WRK2
  205. IF (IREPS2.EQ.1) SEGINI MTRACE
  206. c
  207. c* NDDD=NDEP
  208. c* IF (IFOUR.EQ.-3) NDDD=NDEP-3
  209. NDDD=NDEP-NDPGE
  210. c
  211. DO 3004 IB=1,NBELEM
  212. c
  213. c on cherche les deplacements
  214. c
  215. MPTVAL=IVADEP
  216. IE=1
  217. DO 4004 IGAU=1,NBNN
  218. DO 4004 ICOMP=1,NDDD
  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. 4004 CONTINUE
  225. IF (BDPGE) THEN
  226. DO i=1,NDPGE
  227. XDDL(IE)=UDPGE(i)
  228. IE=IE+1
  229. ENDDO
  230. ENDIF
  231. c
  232. c on cherche les coordonnees des noeuds de l element ib
  233. c
  234. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  235. c
  236. c calcul des axes locaux dans le cas des materiaux orthotropes,
  237. c anisotropes et unidirectionnel
  238. c
  239. C* IF ((MATE.EQ.2.OR.MATE.EQ.3.OR.MATE.EQ.4) .AND. IMAT.EQ.1) THEN
  240. IF (IPMIN2.NE.0) THEN
  241. NBSH=MINTE2.SHPTOT(/2)
  242. CALL RLOCAL(XE,MINTE2.SHPTOT,NBSH,NBNN,TXR)
  243. IF (nbsh.EQ.-1) THEN
  244. CALL ERREUR(525)
  245. GOTO 9904
  246. ENDIF
  247. ENDIF
  248. c
  249. c boucle sur les points de gauss
  250. c
  251. ISDJC=0
  252. c
  253. DO 5004 IGAU=1,NBPTEL
  254. c
  255. c
  256. c calcul des coeff de modification de la matrice b-barre (incompres)
  257. c
  258. IF (MFR.EQ.31.and.igau.eq.1) THEN
  259. C= NOM : ICT3, ICQ4, ICT6, ICQ8, ICC8, ICT4, ICP6, IC20, IC10, IC15
  260. C= MELE : 69 , 70 , 71 , 72 , 73 , 74 , 75 , 76 , 77 , 78
  261. CALL BBCAL2(IB,IGAU,IDIM,NBPGAU,IVACAR,
  262. 1 POIGAU,QSIGAU,ETAGAU,DZEGAU,MELE,MFR,NBNN,LRE,IFOUR,NSTRS,NHRM,
  263. 2 A,BB,XE,SHPTOT,SHPWRK,BGENE,XDPGE,YDPGE,PP)
  264. ENDIF
  265. c
  266. CALL BMATST(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU,
  267. 1 MELE,MFR,NBNN,LRE,IFOUR,NSTRS,NHRM,1.D0,XE,
  268. 2 SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  269. c
  270. IF (DJAC.EQ.0.D0) THEN
  271. INTERR(1)=IB
  272. CALL ERREUR(259)
  273. GOTO 9904
  274. ELSE IF (DJAC.LT.0.D0) THEN
  275. ISDJC=ISDJC+1
  276. ENDIF
  277.  
  278. C En cas d'elements incompressibles : BGENE selon la methode B-BARRE
  279. IF (MFR.EQ.31) THEN
  280. CALL BBAR(IGAU,NBPGAU, POIGAU,QSIGAU,ETAGAU,DZEGAU,
  281. & MELE,NBNN,LRE,IFOUR,NSTRS,XE,DJAC,A,BB,BGENE)
  282. ENDIF
  283. c
  284. c on cherche les matrices de Hooke
  285. c
  286. MPTVAL=IVAMAT
  287. IF (IMAT.EQ.2) THEN
  288. MELVAL=IVAL(1)
  289. IBMN=MIN(IB ,IELCHE(/2))
  290. IGMN=MIN(IGAU,IELCHE(/1))
  291. MLREEL=IELCHE(IGMN,IBMN)
  292. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  293. SEGACT MLREEL
  294. CALL DOHOOO(PROG,LHOOK,DDHOOK)
  295. SEGDES MLREEL
  296. ENDIF
  297. ELSE IF (IMAT.EQ.1) THEN
  298. DO 9004 IM=1,NMATT
  299. IF (IVAL(IM).NE.0) THEN
  300. MELVAL=IVAL(IM)
  301. IBMN=MIN(IB ,VELCHE(/2))
  302. IGMN=MIN(IGAU,VELCHE(/1))
  303. VALMAT(IM)=VELCHE(IGMN,IBMN)
  304. ELSE
  305. VALMAT(IM)=0.D0
  306. ENDIF
  307. 9004 CONTINUE
  308. c
  309. IF (MATE.EQ.2.OR.MATE.EQ.3.OR.MATE.EQ.4) THEN
  310. IF (IGAU.LE.NBGMAT)
  311. 1 CALL DOHMAO(VALMAT,CMATE,IFOUR,IDIM,TXR,XLOC,XGLOB,D1HO,
  312. 2 ROTH,DDHOOK,LHOOK,1,IRTD)
  313. ELSE
  314. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  315. 1 CALL DOHMAS(VALMAT,CMATE,IFOUR,LHOOK,1,DDHOOK,IRTD)
  316. ENDIF
  317. ENDIF
  318. c
  319. CALL DBST(BGENE,DDHOOK,XDDL,LRE,NSTRS,XSTRS)
  320. c
  321. c calcul des eps 2
  322. c
  323. IF (IREPS2.EQ.1)
  324. 1 CALL DBST2(SHPWRK,DDHOOK,XDDL,XE,NBNO,IFOUR,NSTRS,XSTRS,
  325. 2 TRACE,IGAU,XDPGE,YDPGE,UDPGE,NHRM)
  326. c
  327. c remplissage du segment contenant les contraintes
  328. c
  329. MPTVAL=IVASTR
  330. DO 7004 ICOMP=1,NSTRS
  331. MELVAL=IVAL(ICOMP)
  332. IBMN=MIN(IB,VELCHE(/2))
  333. VELCHE(IGAU,IBMN)=XSTRS(ICOMP)
  334. 7004 CONTINUE
  335. c
  336. 5004 CONTINUE
  337. c
  338. IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN
  339. if (inoer.eq.0) then
  340. INTERR(1)=IB
  341. CALL ERREUR(195)
  342. GOTO 9904
  343. else
  344. call soucis(195)
  345. ENDIF
  346. ENDIF
  347. c
  348. c Correction sur la partie quadratique de la contrainte dans le cas
  349. c des elements incompressibles
  350. c
  351. IF (IREPS2.EQ.1) THEN
  352. IF (MFR.EQ.31) THEN
  353. CALL DBBST2(TRACE,NBPTEL,IFOUR,MELE,POIGAU,QSIGAU,
  354. & ETAGAU,DZEGAU,SHPTOT,NBNO,SHPWRK,XE,PP)
  355. L=2
  356. IF (IDIM.EQ.3 .OR. IFOUR .EQ. 0) L=3
  357. DO 5005 ICOMP=1,L
  358. MELVAL=IVAL(ICOMP)
  359. IBMN=MIN(IB ,VELCHE(/2))
  360. DO 5006 IGAU=1,NBPTEL
  361. VELCHE(IGAU,IBMN)=VELCHE(IGAU,IBMN)+TRACE(1,IGAU)
  362. 5006 CONTINUE
  363. 5005 CONTINUE
  364. IF (L.EQ.2) THEN
  365. MELVAL=IVAL(3)
  366. IBMN=MIN(IB ,VELCHE(/2))
  367. DO 5007 IGAU=1,NBPTEL
  368. VELCHE(IGAU,IBMN) = VELCHE(IGAU,IBMN)
  369. & + (TRACE(1,IGAU)/TRACE(2,IGAU)*TRACE(3,IGAU))
  370. 5007 CONTINUE
  371. ENDIF
  372. ENDIF
  373. ENDIF
  374.  
  375. 3004 CONTINUE
  376. c
  377. IF (IRTD.EQ.0) THEN
  378. MOTERR(1:8)=CMATE
  379. MOTERR(9:12)=NOMFR(MFR/2+1)
  380. INTERR(1)=IFOUR
  381. CALL ERREUR(81)
  382. ENDIF
  383. c
  384. 9904 CONTINUE
  385. SEGSUP WRK2
  386. IF (IREPS2.EQ.1) SEGSUP,MTRACE
  387. C* IF ((MATE.EQ.2.OR.MATE.EQ.3.OR.MATE.EQ.4) .AND. IMAT.EQ.1) THEN
  388. IF (IPMIN2.NE.0) THEN
  389. SEGDES MINTE2
  390. SEGSUP WRK8
  391. ENDIF
  392. GOTO 510
  393.  
  394. c____________________________________________________________________
  395. c
  396. c milieux poreux
  397. c____________________________________________________________________
  398. c
  399. 79 CONTINUE
  400. c
  401. c Ces cas ne sont pas prevus actuellement !
  402. IF ( IMAT.EQ.2 .OR.
  403. & (IMAT.EQ.1.AND.(MATE.LT.1.OR.MATE.GT.4))
  404. & ) GOTO 99
  405.  
  406. c pour ces elements nbbb = nombre de noeuds
  407. c nbno = nombre de fonctions de forme
  408. c
  409. NBNO=IPORE
  410. NSTN=1
  411. LPP=0
  412. c***************** AM 08/01/01
  413. c* NSTMU=2
  414. c* IF (IFOUR.GE.0) NSTMU=3
  415. NSTMU=3
  416. LRN=NBNO-NBBB
  417. LRB=LRE-LRN
  418. c
  419. c Cas non isotropes :
  420. c recuperation des fonctions de forme et leurs derivees
  421. c au centre de l'element pour le calcul des axes locaux
  422. c
  423. IPMIN2 = 0
  424. IF ((MATE.EQ.2.OR.MATE.EQ.3.OR.MATE.EQ.4) .AND. IMAT.EQ.1) THEN
  425. CALL RESHPT(1,NBNO,IELE,MELE,0,IPMIN2,IRT1)
  426. MINTE2=IPMIN2
  427. SEGACT MINTE2
  428. SEGINI WRK8
  429. NSTMU=LHOOK
  430. ENDIF
  431. c
  432. SEGINI WRK2,WRK5
  433. c Segment MTRACE initialise ici, necessaire mais inutilise
  434. IF (IREPS2.EQ.1) SEGINI MTRACE
  435. c
  436. I19 =0
  437. c
  438. DO 3079 IB=1,NBELEM
  439. c
  440. c on cherche d'abord les deplacements
  441. c
  442. MPTVAL=IVADEP
  443. IE=1
  444. DO 4079 IGAU=1,NBNN
  445. DO 4079 ICOMP=1,NDEP-1
  446. MELVAL=IVAL(ICOMP)
  447. IGMN=MIN(IGAU,VELCHE(/1))
  448. IBMN=MIN(IB ,VELCHE(/2))
  449. XDDL(IE)=VELCHE(IGMN,IBMN)
  450. IE=IE+1
  451. 4079 CONTINUE
  452. c
  453. c puis les pressions
  454. c
  455. MELVAL=IVAL(NDEP)
  456. DO 40791 IGAU=1,LRN
  457. IGAUSO=IBSOM(NSPOS(IELE)+IGAU-1)
  458. IBMN=MIN(IB ,VELCHE(/2))
  459. IGMN=MIN(IGAUSO,VELCHE(/1))
  460. XDDL(IE)=VELCHE(IGMN,IBMN)
  461. IE=IE+1
  462. 40791 CONTINUE
  463. c
  464. c on cherche les coordonnees des noeuds de l element ib
  465. c
  466. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  467. c
  468. c calcul des axes locaux dans le cas des materiaux orthotropes,
  469. c anisotropes et unidirectionnels
  470. c
  471. C* IF ((MATE.EQ.2.OR.MATE.EQ.3.OR.MATE.EQ.4) .AND. IMAT.EQ.1) THEN
  472. IF (IPMIN2.NE.0) THEN
  473. NBSH=MINTE2.SHPTOT(/2)
  474. CALL RLOCAL (XE,MINTE2.SHPTOT,NBSH,NBNN,TXR)
  475. if (nbsh.eq.-1) then
  476. call erreur(525)
  477. GOTO 9979
  478. endif
  479. ENDIF
  480. c
  481. c boucle sur les points de gauss
  482. c
  483. ISDJC=0
  484. CALL ZERO(COBMA,LHOOK,1)
  485. DO 5079 IGAU=1,NBPTEL
  486. c
  487. CALL BNPORE(IGAU,NBNO,NBBB,LRE,IFOUR,LHOOK,NSTN,NHRM,
  488. . 1.D0,XE,SHPTOT,SHPWRK,BGENE,XGENE,DJAC,1)
  489. c
  490. IF (DJAC.EQ.0.D0) THEN
  491. INTERR(1)=IB
  492. CALL ERREUR(259)
  493. GOTO 9979
  494. ELSE IF (DJAC.LT.0.D0) THEN
  495. ISDJC=ISDJC+1
  496. ENDIF
  497. c
  498. MPTVAL=IVAMAT
  499. C*D IF (IMAT.EQ.2) THEN
  500. C*D cas non prevu
  501. C*D GO TO 99
  502. C*D ELSE IF (IMAT.EQ.1) THEN
  503. DO 9079 IM=1,NMATT
  504. IF (IVAL(IM).NE.0) THEN
  505. MELVAL=IVAL(IM)
  506. IBMN=MIN(IB ,VELCHE(/2))
  507. IGMN=MIN(IGAU,VELCHE(/1))
  508. VALMAT(IM)=VELCHE(IGMN,IBMN)
  509. ELSE
  510. VALMAT(IM)=0.D0
  511. ENDIF
  512. 9079 CONTINUE
  513. IF (MATE.EQ.1) THEN
  514. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  515. . CALL DOHMAS(VALMAT,CMATE,IFOUR,LHOOK,1,DDHOOK,IRTD)
  516. ELSE IF (MATE.EQ.2.OR.MATE.EQ.3.OR.MATE.EQ.4) THEN
  517. IF (IGAU.LE.NBGMAT)
  518. . CALL PORMAO(VALMAT,CMATE,IFOUR,IDIM,TXR,XLOC,XGLOB,D1HO,
  519. . ROTH,DDHOOK,LHOOK,COBMA,XMOB,1,IRTD)
  520. C*D ELSE
  521. C*D GOTO 99
  522. ENDIF
  523. C*D ENDIF
  524. c
  525. CALL BST(BGENE,XDDL,LRE,LHOOK,XSTRS)
  526. c
  527. c calcul des eps 2
  528. c
  529. IF (IREPS2.EQ.1)
  530. & CALL BST2(SHPWRK,XDDL,XE,NBNN,IFOUR,XSTRS,TRACE,IGAU,
  531. & XDPGE,YDPGE,UDPGE,NHRM)
  532. *
  533. * contribution de epsi a msr0
  534. *
  535. IF (MATE.EQ.1) THEN
  536. C*D IF (IMAT.EQ.1) THEN
  537. DO 4879 I=1,NSTMU
  538. COBMA(I)=VALMAT(3)
  539. 4879 CONTINUE
  540. XMOB=VALMAT(4)
  541. C*D ELSE IF (IMAT.EQ.2) THEN
  542. C*D GO TO 99
  543. C*D ENDIF
  544. ENDIF
  545. *
  546. r_z=0.
  547. DO 4878 K=1,NSTMU
  548. r_z = r_z +COBMA(K)*XSTRS(K)
  549. 4878 CONTINUE
  550. XSTRS(NSTRS)=r_z
  551. DO 4877 KA=1,LHOOK
  552. XWRK(KA)=XSTRS(KA)
  553. 4877 CONTINUE
  554. *
  555. DO 4876 KA=1,LHOOK
  556. r_z =0.D0
  557. DO KB=1,LHOOK
  558. r_z = r_z + DDHOOK(KA,KB)*XWRK(KB)
  559. ENDDO
  560. XSTRS(KA)=r_z
  561. 4876 CONTINUE
  562. c
  563. c calcul de l'effet de la pression
  564. c
  565. IF (XMOB.EQ.0.D0) THEN
  566. UNSURM=0.D0
  567. ELSE
  568. UNSURM=1.D0 / XMOB
  569. ENDIF
  570. *
  571. CALL SIGPOR(COBMA,UNSURM,XGENE,NSTN,XDDL,IFOUR,NSTRS,
  572. . XSTRS,LRB,LRN,LPP,MELE,I19,COBB,KKBB,IDECAP)
  573. c
  574. c remplissage du segment contenant les contraintes
  575. c
  576. MPTVAL=IVASTR
  577. DO 7079 ICOMP=1,NSTRS
  578. MELVAL=IVAL(ICOMP)
  579. IBMN=MIN(IB ,VELCHE(/2))
  580. VELCHE(IGAU,IBMN)=XSTRS(ICOMP)
  581. 7079 CONTINUE
  582. c
  583. 5079 CONTINUE
  584. c
  585. IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN
  586. if (inoer.eq.0) then
  587. INTERR(1)=IB
  588. CALL ERREUR(195)
  589. GOTO 9979
  590. else
  591. call soucis(195)
  592. ENDIF
  593. ENDIF
  594. c
  595. 3079 CONTINUE
  596. c
  597. IF (IRTD.EQ.0) THEN
  598. MOTERR(1:8)=CMATE
  599. MOTERR(9:12)=NOMFR(MFR/2+1)
  600. INTERR(1)=IFOUR
  601. CALL ERREUR(81)
  602. ENDIF
  603. IF (I19.NE.0) CALL ERREUR(19)
  604. c
  605. 9979 CONTINUE
  606. SEGSUP WRK2,WRK5
  607. IF (IREPS2.EQ.1) SEGSUP MTRACE
  608. C* IF ((MATE.EQ.2.OR.MATE.EQ.3.OR.MATE.EQ.4) .AND. IMAT.EQ.1) THEN
  609. IF (IPMIN2.NE.0) THEN
  610. SEGDES MINTE2
  611. SEGSUP WRK8
  612. ENDIF
  613. GOTO 510
  614.  
  615. c____________________________________________________________________
  616. c
  617. c milieux poreux SUITE
  618. c____________________________________________________________________
  619. c
  620. 173 CONTINUE
  621. c
  622. c Ces cas ne sont pas prevus actuellement !
  623. IF ( IMAT.EQ.2 .OR. (IMAT.EQ.1.AND.MATE.NE.1) ) GOTO 99
  624. c
  625. c pour ces elements nbbb = nombre de noeuds
  626. c nbno = nombre de fonctions de forme
  627. c
  628. IF (MELE.GE.173.AND.MELE.LE.177) THEN
  629. IDECAP = 2
  630. ELSE IF (MELE.GE.178.AND.MELE.LE.182) THEN
  631. IDECAP = 3
  632. ENDIF
  633. *
  634. NBNO=IPORE
  635. NSTN=IDECAP
  636. NSTB=4
  637. IF(IFOUR.EQ.2) NSTB=6
  638.  
  639. LPP=NBNO-NBBB
  640. LRN=IDECAP*LPP
  641. LRB=LRE-LRN
  642.  
  643. UNSURM = 0.
  644.  
  645. SEGINI WRK2,WRK5
  646. c Segment MTRACE initialise ici (necessaire mais inutilise)
  647. IF (IREPS2.EQ.1) SEGINI MTRACE
  648.  
  649. I19 =0
  650. c
  651. DO 3173 IB=1,NBELEM
  652. c
  653. c on cherche d'abord les deplacements
  654. c
  655. IE=1
  656. MPTVAL=IVADEP
  657. DO 4173 IGAU=1,NBNN
  658. DO 4173 ICOMP=1,NDEP-IDECAP
  659. MELVAL=IVAL(ICOMP)
  660. IGMN=MIN(IGAU,VELCHE(/1))
  661. IBMN=MIN(IB ,VELCHE(/2))
  662. XDDL(IE)=VELCHE(IGMN,IBMN)
  663. IE=IE+1
  664. 4173 CONTINUE
  665. c
  666. c puis les pressions
  667. c
  668. DO 4473 IPR = 1,IDECAP
  669. MELVAL=IVAL(NDEP-IDECAP+IPR)
  670. DO 4273 IGAU=1,LPP
  671. IGAUSO=IBSOM(NSPOS(IELE)+IGAU-1)
  672. IBMN=MIN(IB ,VELCHE(/2))
  673. IGMN=MIN(IGAUSO,VELCHE(/1))
  674. XDDL(IE)=VELCHE(IGMN,IBMN)
  675. IE=IE+1
  676. 4273 CONTINUE
  677. 4473 CONTINUE
  678. c
  679. c on cherche les coordonnees des noeuds de l element ib
  680. c
  681. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  682. c
  683. c boucle sur les points de gauss
  684. c
  685. ISDJC=0
  686. CALL ZERO (COBB,IDECAP,1)
  687. CALL ZERO (CPBB,IDECAP,1)
  688. CALL ZERO (KKBB,IDECAP,IDECAP)
  689. c
  690. DO 5173 IGAU=1,NBPTEL
  691. c
  692. CALL BNQORE(IGAU,NBNO,NBBB,LRE,IFOUR,NSTB,NSTN,NHRM,
  693. & 1.D0,XE,SHPTOT,SHPWRK,BGENE,XGENE,DJAC,IDECAP,LHOOK,1)
  694. c
  695. IF (DJAC.EQ.0.D0) THEN
  696. INTERR(1)=IB
  697. CALL ERREUR(259)
  698. GOTO 9973
  699. ELSE IF (DJAC.LT.0.D0) THEN
  700. ISDJC=ISDJC+1
  701. ENDIF
  702. c
  703. MPTVAL=IVAMAT
  704. C*D IF (IMAT.EQ.2) THEN
  705. C*D GO TO 99
  706. C*D ELSE IF (IMAT.EQ.1) THEN
  707. DO 6173 IM=1,NMATT
  708. IF (IVAL(IM).NE.0) THEN
  709. MELVAL=IVAL(IM)
  710. IBMN=MIN(IB ,VELCHE(/2))
  711. IGMN=MIN(IGAU,VELCHE(/1))
  712. VALMAT(IM)=VELCHE(IGMN,IBMN)
  713. ELSE
  714. VALMAT(IM)=0.D0
  715. ENDIF
  716. 6173 CONTINUE
  717. C*D IF (MATE.EQ.1) THEN
  718. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  719. . CALL DOHMAS(VALMAT,CMATE,IFOUR,LHOOK,1,DDHOOK,IRTD)
  720. C*D ELSE
  721. C*D GOTO 99
  722. C*D ENDIF
  723. C*D ENDIF
  724. c
  725. IF (MFR.EQ.57) THEN
  726. COBB(1) = VALMAT(3)
  727. COBB(2) = VALMAT(4)
  728. CPBB(1) = VALMAT(5)
  729. CPBB(2) = VALMAT(6)
  730. KKBB(1,1)= VALMAT(7)
  731. KKBB(1,2)= VALMAT(8)
  732. KKBB(2,1)= VALMAT(9)
  733. KKBB(2,2)= VALMAT(10)
  734. ELSE IF(MFR.EQ.59) THEN
  735. COBB(1) = VALMAT(3)
  736. COBB(2) = VALMAT(4)
  737. COBB(3) = VALMAT(5)
  738. CPBB(1) = VALMAT(6)
  739. CPBB(2) = VALMAT(7)
  740. CPBB(3) = VALMAT(8)
  741. KKBB(1,1)= VALMAT(9)
  742. KKBB(1,2)= VALMAT(10)
  743. KKBB(1,3)= VALMAT(11)
  744. KKBB(2,1)= VALMAT(12)
  745. KKBB(2,2)= VALMAT(13)
  746. KKBB(2,3)= VALMAT(14)
  747. KKBB(3,1)= VALMAT(15)
  748. KKBB(3,2)= VALMAT(16)
  749. KKBB(3,3)= VALMAT(17)
  750. ENDIF
  751. c
  752. CALL BST(BGENE,XDDL,LRE,LHOOK,XSTRS)
  753. c
  754. c calcul des eps 2
  755. c
  756. IF (IREPS2.EQ.1)
  757. & CALL BST2(SHPWRK,XDDL,XE,NBNN,IFOUR,XSTRS,TRACE,IGAU,
  758. & XDPGE,YDPGE,UDPGE,NHRM)
  759. c
  760. c contribution de epsi a msr0
  761. c
  762. TRACEP=XSTRS(1)+XSTRS(2)+XSTRS(3)
  763. DO 4873 K=1,IDECAP
  764. XSTRS(NSTRS-IDECAP+K)=CPBB(K)*TRACEP
  765. 4873 CONTINUE
  766. DO 4773 KA=1,LHOOK
  767. XWRK(KA)=XSTRS(KA)
  768. 4773 CONTINUE
  769. DO 7873 KA=1,LHOOK
  770. r_z = 0.D0
  771. DO KB=1,LHOOK
  772. r_z = r_z + DDHOOK(KA,KB)*XWRK(KB)
  773. ENDDO
  774. XSTRS(KA) = r_z
  775. 7873 CONTINUE
  776. c
  777. c calcul de l'effet de la pression
  778. c
  779. CALL SIGPOR(COBMA,UNSURM,XGENE,NSTN,XDDL,IFOUR,NSTRS,
  780. . XSTRS,LRB,LRN,LPP,MELE,I19,COBB,KKBB,IDECAP)
  781. c
  782. c remplissage du segment contenant les contraintes
  783. c
  784. MPTVAL=IVASTR
  785. DO 7073 ICOMP=1,NSTRS
  786. MELVAL=IVAL(ICOMP)
  787. IBMN=MIN(IB ,VELCHE(/2))
  788. VELCHE(IGAU,IBMN)=XSTRS(ICOMP)
  789. 7073 CONTINUE
  790. c
  791. 5173 CONTINUE
  792. c
  793. IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN
  794. if (inoer.eq.0) then
  795. INTERR(1)=IB
  796. CALL ERREUR(195)
  797. GOTO 9973
  798. else
  799. call soucis(195)
  800. ENDIF
  801. ENDIF
  802. c
  803. 3173 CONTINUE
  804. c
  805. IF (I19.NE.0) CALL ERREUR(19)
  806. IF (IRTD.EQ.0) THEN
  807. MOTERR(1:8)=CMATE
  808. MOTERR(9:12)=NOMFR(MFR/2+1)
  809. INTERR(1)=IFOUR
  810. CALL ERREUR(81)
  811. ENDIF
  812. 9973 CONTINUE
  813. SEGSUP WRK2,WRK5
  814. IF (IREPS2.EQ.1) SEGSUP MTRACE
  815. GOTO 510
  816.  
  817. c____________________________________________________________________
  818. c
  819. c joints poreux
  820. c____________________________________________________________________
  821. c
  822. 80 CONTINUE
  823. c Ces cas ne sont pas prevus actuellement !
  824. IF ( IMAT.EQ.2 .OR. (IMAT.EQ.1.AND.MATE.NE.1) ) GOTO 99
  825. c
  826. c pour ces elements nbbb = nombre de noeuds
  827. c nbno = nombre de fonctions de forme
  828. c
  829. NBNO=IPORE
  830. NSTN=1
  831. NSTMU=2
  832. IF (IFOUR.EQ.2) NSTMU=3
  833. LRN=(NBNO-NBBB)*3/2
  834. LRB=LRE-LRN
  835. NFAC=(3*NBBB-NBNO)/2
  836. c
  837. SEGINI WRK2,WRK3,WRK5
  838. c
  839. I19 =0
  840. c
  841. DO 3080 IB=1,NBELEM
  842. c
  843. c on cherche d'abord les deplacements
  844. c
  845. MPTVAL=IVADEP
  846. IE=1
  847. DO 4180 IGAU=1,NFAC
  848. DO 4280 ICOMP=1,NDEP-1
  849. MELVAL=IVAL(ICOMP)
  850. IGMN=MIN(IGAU,VELCHE(/1))
  851. IBMN=MIN(IB ,VELCHE(/2))
  852. XDDL(IE)=VELCHE(IGMN,IBMN)
  853. IE=IE+1
  854. 4280 CONTINUE
  855. 4180 CONTINUE
  856. c
  857. c puis les pressions
  858. c
  859. MELVAL=IVAL(NDEP)
  860. DO 4080 IGAU=1,NBNN
  861. DO 4190 INSOM=1,NBSOM(IELE)
  862. IF (IGAU.EQ.IBSOM(NSPOS(IELE)+INSOM-1)) GOTO 4191
  863. 4190 CONTINUE
  864. IF (IGAU.GT.NFAC) GOTO 4191
  865. GOTO 4080
  866. 4191 CONTINUE
  867. IBMN=MIN(IB ,VELCHE(/2))
  868. IGMN=MIN(IGAU,VELCHE(/1))
  869. XDDL(IE)=VELCHE(IGMN,IBMN)
  870. IE=IE+1
  871. 4080 CONTINUE
  872. c
  873. c on cherche les coordonnees des noeuds de l element ib
  874. c
  875. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  876. c
  877. c calcul des exes locaux et des coordonnees locales
  878. c
  879. CALL JOPLOC(XE,SHPTOT,NBBB,NBNO,IFOUR,XEL,BPSS)
  880. c
  881. c boucle sur les points de gauss
  882. c
  883. ISDJC=0
  884. CALL ZERO(COBMA,LHOOK,1)
  885. c
  886. DO 5080 IGAU=1,NBPTEL
  887. c
  888. CALL BNPORJ(IGAU,NBNO,NBBB,LRE,IFOUR,LHOOK,NSTN,XE,XEL,
  889. . SHPTOT,SHPWRK,BPSS,BGENE,XGENE,DJAC,1)
  890. c
  891. IF (DJAC.EQ.0.D0) THEN
  892. INTERR(1)=IB
  893. CALL ERREUR(259)
  894. GOTO 9980
  895. ELSE IF (DJAC.LT.0.D0) THEN
  896. ISDJC=ISDJC+1
  897. ENDIF
  898. c
  899. MPTVAL=IVAMAT
  900. C*D IF (IMAT.EQ.2) THEN
  901. C*D GO TO 99
  902. C*D ELSE IF (IMAT.EQ.1) THEN
  903. DO 9080 IM=1,NMATT
  904. IF (IVAL(IM).NE.0) THEN
  905. MELVAL=IVAL(IM)
  906. IBMN=MIN(IB ,VELCHE(/2))
  907. IGMN=MIN(IGAU,VELCHE(/1))
  908. VALMAT(IM)=VELCHE(IGMN,IBMN)
  909. ELSE
  910. VALMAT(IM)=0.D0
  911. ENDIF
  912. 9080 CONTINUE
  913. C*D IF (MATE.EQ.1) THEN
  914. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  915. & CALL DOUO88(VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  916. C*D ELSE
  917. C*D GO TO 99
  918. C*D ENDIF
  919. C*D ENDIF
  920. c
  921. CALL BST(BGENE,XDDL,LRB,LHOOK,XSTRS)
  922. c
  923. c contribution de epsi a msr0
  924. c
  925. IF (IMAT.EQ.1) THEN
  926. COBMA(NSTMU)=VALMAT(3)
  927. XMOB=VALMAT(4)
  928. ENDIF
  929. XSTRS(NSTRS)=COBMA(NSTMU)*XSTRS(NSTMU)
  930.  
  931. DO 4887 KA=1,LHOOK
  932. XWRK(KA)=XSTRS(KA)
  933. 4887 CONTINUE
  934.  
  935. DO 4886 KA=1,LHOOK
  936. r_z = 0.D0
  937. DO KB=1,LHOOK
  938. r_z = r_z + DDHOOK(KA,KB)*XWRK(KB)
  939. ENDDO
  940. XSTRS(KA)= r_z
  941. 4886 CONTINUE
  942. c
  943. c calcul de l'effet de la pression
  944. c
  945. IF (XMOB.EQ.0.D0) THEN
  946. UNSURM=0.D0
  947. ELSE
  948. UNSURM=1.D0 / XMOB
  949. ENDIF
  950. c
  951. CALL SIGPOR(COBMA,UNSURM,XGENE,NSTN,XDDL,IFOUR,NSTRS,
  952. . XSTRS,LRB,LRN,LPP,MELE,I19,COBB,KKBB,IDECAP)
  953. c
  954. c remplissage du segment contenant les contraintes
  955. c
  956. MPTVAL=IVASTR
  957. DO 7080 ICOMP=1,NSTRS
  958. MELVAL=IVAL(ICOMP)
  959. IBMN=MIN(IB ,VELCHE(/2))
  960. VELCHE(IGAU,IBMN)=XSTRS(ICOMP)
  961. 7080 CONTINUE
  962. c
  963. 5080 CONTINUE
  964. c
  965. IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN
  966. if (inoer.eq.0) then
  967. INTERR(1)=IB
  968. CALL ERREUR(195)
  969. GOTO 9980
  970. else
  971. call soucis(195)
  972. ENDIF
  973. ENDIF
  974. c
  975. 3080 CONTINUE
  976. c
  977. IF (IRTD.EQ.0) THEN
  978. MOTERR(1:8)=CMATE
  979. MOTERR(9:12)=NOMFR(MFR/2+1)
  980. INTERR(1)=IFOUR
  981. CALL ERREUR(81)
  982. ENDIF
  983. IF (I19.NE.0) CALL ERREUR(19)
  984. 9980 CONTINUE
  985. SEGSUP,WRK2,WRK3,WRK5
  986. GOTO 510
  987.  
  988.  
  989. c____________________________________________________________________
  990. c
  991. c joints poreux - SUITE
  992. c____________________________________________________________________
  993. c
  994. 185 CONTINUE
  995. c Ces cas ne sont pas prevus actuellement !
  996. IF ( IMAT.EQ.2 .OR. (IMAT.EQ.1.AND.MATE.NE.1) ) GOTO 99
  997. c
  998. c pour ces elements nbbb = nombre de noeuds
  999. c nbno = nombre de fonctions de forme
  1000. c
  1001. IF (MELE.GE.185.AND.MELE.LE.187) THEN
  1002. IDECAP = 2
  1003. ELSE IF (MELE.GE.188.AND.MELE.LE.190) THEN
  1004. IDECAP = 3
  1005. ENDIF
  1006.  
  1007. NBNO=IPORE
  1008. NSTN=IDECAP
  1009. NSTMU=2
  1010. IF (IFOUR.EQ.2) NSTMU=3
  1011. NSTB=NSTMU
  1012. LPP=(NBNO-NBBB)*3/2
  1013. LRN=IDECAP*LPP
  1014. LRB=LRE-LRN
  1015.  
  1016. UNSURM = 0.
  1017.  
  1018. NFAC=(3*NBBB-NBNO)/2
  1019. c
  1020. SEGINI WRK2,WRK3,WRK5
  1021. c
  1022. I19 =0
  1023. c
  1024. DO 3185 IB=1,NBELEM
  1025. c
  1026. c on cherche d'abord les deplacements
  1027. c
  1028. MPTVAL=IVADEP
  1029. IE=1
  1030. DO 4185 IGAU=1,NFAC
  1031. DO 4285 ICOMP=1,NDEP-1
  1032. MELVAL=IVAL(ICOMP)
  1033. IGMN=MIN(IGAU,VELCHE(/1))
  1034. IBMN=MIN(IB ,VELCHE(/2))
  1035. XDDL(IE)=VELCHE(IGMN,IBMN)
  1036. IE=IE+1
  1037. 4285 CONTINUE
  1038. 4185 CONTINUE
  1039. c
  1040. c puis les pressions
  1041. c
  1042. DO 4585 IPR=1,IDECAP
  1043. MELVAL=IVAL(NDEP-IDECAP+IPR)
  1044. DO 4085 IGAU=1,NBNN
  1045. DO 4195 INSOM=1,NBSOM(IELE)
  1046. IF (IGAU.EQ.IBSOM(NSPOS(IELE)+INSOM-1)) GOTO 4995
  1047. 4195 CONTINUE
  1048. IF (IGAU.GT.NFAC) GOTO 4995
  1049. GOTO 4085
  1050. 4995 CONTINUE
  1051. IBMN=MIN(IB ,VELCHE(/2))
  1052. IGMN=MIN(IGAU,VELCHE(/1))
  1053. XDDL(IE)=VELCHE(IGMN,IBMN)
  1054. IE=IE+1
  1055. 4085 CONTINUE
  1056. 4585 CONTINUE
  1057. c
  1058. c on cherche les coordonnees des noeuds de l element ib
  1059. c
  1060. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1061. c
  1062. c calcul des exes locaux et des coordonnees locales
  1063. c
  1064. CALL JOPLOC(XE,SHPTOT,NBBB,NBNO,IFOUR,XEL,BPSS)
  1065. c
  1066. c boucle sur les points de gauss
  1067. c
  1068. ISDJC=0
  1069. CALL ZERO (COBB,IDECAP,1)
  1070. CALL ZERO (CPBB,IDECAP,1)
  1071. CALL ZERO (KKBB,IDECAP,IDECAP)
  1072. c
  1073. DO 5185 IGAU=1,NBPTEL
  1074. c
  1075. CALL BNPQRJ(IGAU,NBNO,NBBB,LRE,IFOUR,LHOOK,NSTN,XE,XEL,
  1076. & SHPTOT,SHPWRK,BPSS,BGENE,XGENE,DJAC,IDECAP,NSTB,1)
  1077. c
  1078. IF (DJAC.EQ.0.D0) THEN
  1079. INTERR(1)=IB
  1080. CALL ERREUR(259)
  1081. GOTO 9980
  1082. ELSE IF (DJAC.LT.0.D0) THEN
  1083. ISDJC=ISDJC+1
  1084. ENDIF
  1085. c
  1086. MPTVAL=IVAMAT
  1087. C*D IF (IMAT.EQ.2) THEN
  1088. C*D GO TO 99
  1089. C*D ELSE IF (IMAT.EQ.1) THEN
  1090. DO 9185 IM=1,NMATT
  1091. IF (IVAL(IM).NE.0) THEN
  1092. MELVAL=IVAL(IM)
  1093. IBMN=MIN(IB ,VELCHE(/2))
  1094. IGMN=MIN(IGAU,VELCHE(/1))
  1095. VALMAT(IM)=VELCHE(IGMN,IBMN)
  1096. ELSE
  1097. VALMAT(IM)=0.D0
  1098. ENDIF
  1099. 9185 CONTINUE
  1100. C*D IF (MATE.EQ.1) THEN
  1101.  
  1102. *ZZZZZZZZZZZZZ VOIR SI LHOOK POSE PB A CE NIVEAU ????
  1103.  
  1104. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  1105. & CALL DOUO88(VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  1106. C*D ELSE
  1107. C*D GO TO 99
  1108. C*D ENDIF
  1109. C*D ENDIF
  1110. c
  1111. CALL BST(BGENE,XDDL,LRB,LHOOK,XSTRS)
  1112. c
  1113. c contribution de epsi a msr0
  1114. c
  1115. IF (MFR.EQ.57) THEN
  1116. COBB(1) = VALMAT(3)
  1117. COBB(2) = VALMAT(4)
  1118. CPBB(1) = VALMAT(5)
  1119. CPBB(2) = VALMAT(6)
  1120. KKBB(1,1)= VALMAT(7)
  1121. KKBB(1,2)= VALMAT(8)
  1122. KKBB(2,1)= VALMAT(9)
  1123. KKBB(2,2)= VALMAT(10)
  1124. ELSE IF(MFR.EQ.59) THEN
  1125. COBB(1) = VALMAT(3)
  1126. COBB(2) = VALMAT(4)
  1127. COBB(3) = VALMAT(5)
  1128. CPBB(1) = VALMAT(6)
  1129. CPBB(2) = VALMAT(7)
  1130. CPBB(3) = VALMAT(8)
  1131. KKBB(1,1)= VALMAT(9)
  1132. KKBB(1,2)= VALMAT(10)
  1133. KKBB(1,3)= VALMAT(11)
  1134. KKBB(2,1)= VALMAT(12)
  1135. KKBB(2,2)= VALMAT(13)
  1136. KKBB(2,3)= VALMAT(14)
  1137. KKBB(3,1)= VALMAT(15)
  1138. KKBB(3,2)= VALMAT(16)
  1139. KKBB(3,3)= VALMAT(17)
  1140. ENDIF
  1141. c
  1142. CCCCC ICI A FINIR PENSER A BNQORE AUSSI A CORRIGER
  1143.  
  1144.  
  1145. XSTRS(NSTRS)=COBMA(NSTMU)*XSTRS(NSTMU)
  1146.  
  1147. DO 4885 KA=1,LHOOK
  1148. XWRK(KA)=XSTRS(KA)
  1149. 4885 CONTINUE
  1150.  
  1151. DO 4785 KA=1,LHOOK
  1152. r_z = 0.D0
  1153. DO KB=1,LHOOK
  1154. r_z = r_z + DDHOOK(KA,KB)*XWRK(KB)
  1155. ENDDO
  1156. XSTRS(KA)= r_z
  1157. 4785 CONTINUE
  1158. c
  1159. c calcul de l'effet de la pression
  1160. c
  1161. IF (XMOB.EQ.0.D0) THEN
  1162. UNSURM=0.D0
  1163. ELSE
  1164. UNSURM=1.D0 / XMOB
  1165. ENDIF
  1166. c
  1167. CALL SIGPOR(COBMA,UNSURM,XGENE,NSTN,XDDL,IFOUR,NSTRS,
  1168. . XSTRS,LRB,LRN,LPP,MELE,I19,COBB,KKBB,IDECAP)
  1169. c
  1170. c remplissage du segment contenant les contraintes
  1171. c
  1172. MPTVAL=IVASTR
  1173. DO 7185 ICOMP=1,NSTRS
  1174. MELVAL=IVAL(ICOMP)
  1175. IBMN=MIN(IB ,VELCHE(/2))
  1176. VELCHE(IGAU,IBMN)=XSTRS(ICOMP)
  1177. 7185 CONTINUE
  1178. c
  1179. 5185 CONTINUE
  1180. c
  1181. IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN
  1182. if (inoer.eq.0) then
  1183. INTERR(1)=IB
  1184. CALL ERREUR(195)
  1185. GOTO 9985
  1186. else
  1187. call soucis(195)
  1188. ENDIF
  1189. ENDIF
  1190. c
  1191. 3185 CONTINUE
  1192. c
  1193. IF (IRTD.EQ.0) THEN
  1194. MOTERR(1:8)=CMATE
  1195. MOTERR(9:12)=NOMFR(MFR/2+1)
  1196. INTERR(1)=IFOUR
  1197. CALL ERREUR(81)
  1198. ENDIF
  1199. IF (I19.NE.0) CALL ERREUR(19)
  1200. 9985 CONTINUE
  1201. SEGSUP,WRK2,WRK3,WRK5
  1202. GOTO 510
  1203.  
  1204. c____________________________________________________________________
  1205. 99 CONTINUE
  1206. MOTERR(1:4)=NOMTP(MELE)
  1207. MOTERR(9:12)='SIGM'
  1208. CALL ERREUR(86)
  1209.  
  1210. C- Fin du sous-programme
  1211. 510 CONTINUE
  1212. SEGSUP,MVELCH,WRK1
  1213.  
  1214. RETURN
  1215. END
  1216.  
  1217.  
  1218.  
  1219.  
  1220.  
  1221.  
  1222.  
  1223.  
  1224.  
  1225.  
  1226.  
  1227.  
  1228.  

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