Télécharger bsigm2.eso

Retour à la liste

Numérotation des lignes :

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

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