Télécharger bsigm2.eso

Retour à la liste

Numérotation des lignes :

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

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