Télécharger jacono.eso

Retour à la liste

Numérotation des lignes :

  1. C JACONO SOURCE BP208322 17/03/30 21:15:06 9385
  2. SUBROUTINE JACONO(IPMODL,INORM,IPCHE,IRET)
  3. C=======================================================================
  4. C ENTREES :
  5. C ---------
  6. C IPMODL= pointeur sur un MMODEL
  7. C INORM = 1 si les vecteurs doivent etre normes 0 sinon
  8. C
  9. C SORTIES :
  10. C --------
  11. C
  12. C IPCHE = CHAMELEM contenant les JACOBIENS
  13. C ( = normale aux faces des elements dans le cas des coques)
  14. C ( = tangente a la fibre neutre dans le cas des poutres)
  15. C IRET = 1 si succes 0 sinon
  16. C
  17. C Passage au nouveau Chamelem PAR S.RAMAHANDRY le 11/09/90
  18. C
  19. C 2013-01-02 (BP) : ajout zones cohesives (ZCO2,3 et 4 => coque mince)
  20. C + calcul de la tangente pour les poutres
  21. C
  22. C
  23. C=====================================================================
  24. IMPLICIT INTEGER(I-N)
  25. IMPLICIT REAL*8(A-H,O-Z)
  26. PARAMETER(UN=1.D0,XZER=0.D0)
  27. -INC CCOPTIO
  28. -INC CCHAMP
  29. -INC SMCHAML
  30. -INC SMMODEL
  31. -INC SMELEME
  32. -INC SMCOORD
  33. -INC SMINTE
  34. C
  35. SEGMENT TRA
  36. REAL*8 XEL(3,NBNN) ,SHP(6,NBNN) ,XE(3,NBNN)
  37. ENDSEGMENT
  38. C
  39. SEGMENT TR1
  40. REAL*8 TH(NBN1) ,TXR(3,3,NBN1) ,XJ(3,3)
  41. ENDSEGMENT
  42. C
  43. SEGMENT INFO
  44. INTEGER INFELL(JG)
  45. ENDSEGMENT
  46. C
  47. SEGMENT MPTVAL
  48. INTEGER IPOS(NS) , NSOF(NS)
  49. INTEGER IVAL(NCOSOU)
  50. CHARACTER*16 TYVAL(NCOSOU)
  51. ENDSEGMENT
  52. C
  53. DIMENSION BPSS(3,3)
  54. CHARACTER*8 CMATE
  55. C
  56. REAL*8 XU(3)
  57. REAL*8 XV(3)
  58. REAL*8 XW(3)
  59. C
  60. NHRM=NIFOUR
  61. IRET=1
  62. C
  63. C ACTIVATION DU MODELE
  64. C
  65. MMODEL= IPMODL
  66. SEGACT MMODEL
  67. NSOUS=KMODEL(/1)
  68. C
  69. C CREATION DU MCHELM
  70. C
  71. N1=NSOUS
  72. L1=8
  73. N3=6
  74. SEGINI MCHELM
  75. IPCHE=MCHELM
  76. IF (INORM .EQ. 1) THEN
  77. TITCHE='NORMALES'
  78. ELSE
  79. TITCHE='VECTEURS SURFACE'
  80. ENDIF
  81. IFOCHE=IFOUR
  82. IRT8=1
  83. C____________________________________________________________________
  84. C
  85. C DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
  86. C____________________________________________________________________
  87. C
  88. DO 500 ISOUS=1,NSOUS
  89. C
  90. C ON RECUPERE L INFORMATION GENERALE
  91. C
  92. IMODEL=KMODEL(ISOUS)
  93. SEGACT IMODEL
  94. IPMAIL=IMAMOD
  95. IMACHE(ISOUS)=IPMAIL
  96. CONCHE(ISOUS)=CONMOD
  97. C
  98. C TRAITEMENT DU MODELE
  99. C
  100. MELE=NEFMOD
  101. MELEME=IMAMOD
  102. NFOR=FORMOD(/2)
  103. NMAT=MATMOD(/2)
  104. C____________________________________________________________________
  105. C
  106. C INFORMATION SUR L'ELEMENT FINI
  107. C____________________________________________________________________
  108. C
  109. if(infmod(/1).lt.7) then
  110. CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  111. IF (IERR.NE.0) THEN
  112. SEGDES IMODEL,MMODEL
  113. SEGSUP MCHELM
  114. IRET=0
  115. RETURN
  116. ENDIF
  117. INFO=IPINF
  118. MELE =INFELL(1)
  119. MFR =INFELL(13)
  120. MINTE=INFELL(11)
  121. MINTE1=INFELL(12)
  122. segsup info
  123. else
  124. MELE =INFELE(1)
  125. MFR =INFELE(13)
  126. MINTE=INFMOD(7)
  127. MINTE1=INFMOD(8)
  128. endif
  129. C
  130. INFCHE(ISOUS,1)=0
  131. INFCHE(ISOUS,2)=0
  132. INFCHE(ISOUS,3)=NHRM
  133. INFCHE(ISOUS,4)=MINTE
  134. INFCHE(ISOUS,5)=0
  135. INFCHE(ISOUS,6)=5
  136. C
  137. C INITIALISATION DE MINTE
  138. C
  139. SEGACT MINTE
  140. NBPGAU=POIGAU(/1)
  141. C
  142. C ACTIVATION DU MELEME
  143. C
  144. SEGACT MELEME
  145. NBNN =NUM(/1)
  146. NBELEM=NUM(/2)
  147. C
  148. C RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER
  149. C
  150. IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9 .OR. MFR.EQ.77) THEN
  151. N1PTEL=NBPGAU
  152. N1EL=NBELEM
  153. ELSEIF(MFR.EQ.7 .OR. MFR.EQ.13) THEN
  154. N1PTEL=NBPGAU
  155. N1EL=NBELEM
  156. ELSE
  157. N1PTEL = 0
  158. N1EL = 0
  159. ENDIF
  160. C
  161. C CREATION DU MCHAML DE LA SOUS ZONE
  162. C
  163. NJAC=IDIM
  164. N2 = IDIM
  165. SEGINI MCHAML
  166. ICHAML(ISOUS)=MCHAML
  167. NS=1
  168. NCOSOU=NJAC
  169. SEGINI MPTVAL
  170. IVAJAC=MPTVAL
  171. C
  172. C 2 OU 3 COMPOSANTES
  173. C
  174. ICOMP=1
  175. IF (IFOUR.EQ.0.OR.IFOUR.EQ.1) THEN
  176. NOMCHE(ICOMP)='VR '
  177. ELSE
  178. NOMCHE(ICOMP)='VX '
  179. ENDIF
  180. TYPCHE(ICOMP)='REAL*8'
  181. N2PTEL=0
  182. N2EL=0
  183. SEGINI MELVA1
  184. IELVAL(ICOMP)=MELVA1
  185. IVAL(ICOMP)=MELVA1
  186. C
  187. ICOMP=2
  188. IF (IFOUR.EQ.0.OR.IFOUR.EQ.1) THEN
  189. NOMCHE(ICOMP)='VZ '
  190. ELSE
  191. NOMCHE(ICOMP)='VY '
  192. ENDIF
  193. TYPCHE(ICOMP)='REAL*8'
  194. N2PTEL=0
  195. N2EL=0
  196. SEGINI MELVA2
  197. IELVAL(ICOMP)=MELVA2
  198. IVAL(ICOMP)=MELVA2
  199. C
  200. IF (IDIM .EQ. 3) THEN
  201. ICOMP=3
  202. NOMCHE(ICOMP)='VZ '
  203. TYPCHE(ICOMP)='REAL*8'
  204. N2PTEL=0
  205. N2EL=0
  206. SEGINI MELVA3
  207. IELVAL(ICOMP)=MELVA3
  208. IVAL(ICOMP)=MELVA3
  209. ENDIF
  210. C
  211. 44 CONTINUE
  212. C
  213. SEGINI TRA
  214. C
  215. C ================ FORMULATION MASSIVE =======================
  216. C
  217. C
  218. IF(MFR.EQ.1.OR.MFR.EQ.33) THEN
  219. GOTO 520
  220. C
  221. C ================ FORMULATION COQUE MINCE =====================
  222. C
  223. C
  224. ELSE IF(MFR.EQ.3.OR.MFR.EQ.9 .OR. MFR.EQ.77) THEN
  225. IDI2=IDIM-1
  226. DO 3000 IB=1,NBELEM
  227. *--------------Calcul de la normale a l'élément
  228. IREF1 = (IDIM + 1)*(MELEME.NUM(1, IB) - 1)
  229. IREF2 = (IDIM + 1)*(MELEME.NUM(2, IB) - 1)
  230. DO 28 IC = 1, IDIM
  231. 28 XU(IC) = XCOOR(IREF2+IC)-XCOOR(IREF1+IC)
  232. XNORU = 0.
  233. DO 31 IC = 1, IDIM
  234. 31 XNORU = XNORU + XU(IC)*XU(IC)
  235. XNORU = SQRT(XNORU)
  236. DO 32 IC = 1, IDIM
  237. 32 XU(IC) = XU(IC)/XNORU
  238. IF (IDIM .EQ. 2) THEN
  239. XW(1) = -XU(2)
  240. XW(2) = XU(1)
  241. ELSE
  242. IN = 3
  243. 33 IREF3 = (IDIM + 1)*(MELEME.NUM(IN, IB) - 1)
  244. DO 34 IC = 1, IDIM
  245. 34 XV(IC) = XCOOR(IREF3+IC)-XCOOR(IREF1+IC)
  246. XNORV = 0.
  247. DO 35 IC = 1, IDIM
  248. 35 XNORV = XNORV + XV(IC)*XV(IC)
  249. XNORV = SQRT(XNORV)
  250. DO 36 IC = 1, IDIM
  251. 36 XV(IC) = XV(IC)/XNORV
  252. XW(1) = XU(2)*XV(3) - XU(3)*XV(2)
  253. XW(2) = XU(3)*XV(1) - XU(1)*XV(3)
  254. XW(3) = XU(1)*XV(2) - XU(2)*XV(1)
  255. XNORW = 0.
  256. DO 37 IC = 1, IDIM
  257. 37 XNORW = XNORW + XW(IC)*XW(IC)
  258. IF (XNORW .LT. 1.E-4) THEN
  259. IN = IN + 1
  260. if(IN.le.NBNN) GOTO 33
  261. ENDIF
  262. XNORW = SQRT(XNORW)
  263. IF(XNORW .LT.1.E-4) call erreur(345)
  264. DO 38 IC = 1, IDIM
  265. 38 XW(IC) = XW(IC)/XNORW
  266. ENDIF
  267. *--------------Fin du calcul de la normale a l'élément
  268. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  269. C
  270. IF(IDIM.EQ.2)THEN
  271. CALL VPAST2(XE,BPSS)
  272. ELSE IF(IDIM.EQ.3) THEN
  273. CALL VPAST(XE,BPSS)
  274. ENDIF
  275. CALL VCORL1(XE,XEL,BPSS,NBNN)
  276. DO 3002 IC=1,NBPGAU
  277. IF (INORM .EQ. 1) THEN
  278. DJAC = 1.
  279. ELSE
  280. DO 3003 ID=1,6
  281. DO 3003 IE=1,NBNN
  282. SHP(ID,IE)=SHPTOT(ID,IE,IC)
  283. 3003 CONTINUE
  284. CALL JACOBI(XEL,SHP,IDI2,NBNN,DJAC)
  285. ENDIF
  286. MPTVAL=IVAJAC
  287. MELVAL = IVAL(1)
  288. IBMN=MIN(IB, MELVAL.VELCHE(/2))
  289. IGMN=MIN(IC,MELVAL.VELCHE(/1))
  290. MELVAL.VELCHE(IGMN,IBMN)=DJAC*XW(1)
  291. MELVAL = IVAL(2)
  292. IBMN=MIN(IB, MELVAL.VELCHE(/2))
  293. IGMN=MIN(IC,MELVAL.VELCHE(/1))
  294. MELVAL.VELCHE(IGMN,IBMN)=DJAC*XW(2)
  295. IF (IDIM .EQ. 3) THEN
  296. MELVAL = IVAL(3)
  297. IBMN=MIN(IB, MELVAL.VELCHE(/2))
  298. IGMN=MIN(IC,MELVAL.VELCHE(/1))
  299. MELVAL.VELCHE(IGMN,IBMN)=DJAC*XW(3)
  300. ENDIF
  301. 3002 CONTINUE
  302. 3000 CONTINUE
  303. GOTO 520
  304. C
  305. C ================ FORMULATION POUTRE ET TUYAU ====================
  306. C
  307. C
  308. ELSE IF(MFR.EQ.7.OR.MFR.EQ.13) THEN
  309. IDI2=IDIM-1
  310. DO 4000 IB=1,NBELEM
  311. *-----------Calcul de la tangente a l'élément
  312. IREF1 = (IDIM + 1)*(MELEME.NUM(1, IB) - 1)
  313. IREF2 = (IDIM + 1)*(MELEME.NUM(2, IB) - 1)
  314. DO 41 IC = 1, IDIM
  315. 41 XU(IC) = XCOOR(IREF2+IC)-XCOOR(IREF1+IC)
  316. XNORU = 0.D0
  317. DO 42 IC = 1, IDIM
  318. 42 XNORU = XNORU + XU(IC)*XU(IC)
  319. XNORU = SQRT(XNORU)
  320. DO 43 IC = 1, IDIM
  321. 43 XU(IC) = XU(IC)/XNORU
  322. *-----------Fin du calcul de la tangente a l'élément
  323. *-----------Calcul de la tangente a l'élément en chaque point de Gauss
  324. c BP : On suppose le jacobien constant dans l'element (idem POUJAC.eso)
  325. C => on sort le calcul du jacobien de la boucle sur les points de Gauss.
  326. C Cela implique que la POUTre de Bernoulli n'est pas isoparamétrique...
  327. IF (INORM .EQ. 1) THEN
  328. DJAC = 1.D0
  329. ELSE
  330. DJAC = 1.D0/DBLE(NBPGAU)
  331. ENDIF
  332. DO 4002 IC=1,NBPGAU
  333. MPTVAL=IVAJAC
  334. MELVAL = IVAL(1)
  335. IBMN=MIN(IB, MELVAL.VELCHE(/2))
  336. IGMN=MIN(IC,MELVAL.VELCHE(/1))
  337. MELVAL.VELCHE(IGMN,IBMN)=DJAC*XU(1)
  338. MELVAL = IVAL(2)
  339. IBMN=MIN(IB, MELVAL.VELCHE(/2))
  340. IGMN=MIN(IC,MELVAL.VELCHE(/1))
  341. MELVAL.VELCHE(IGMN,IBMN)=DJAC*XU(2)
  342. IF (IDIM .EQ. 3) THEN
  343. MELVAL = IVAL(3)
  344. IBMN=MIN(IB, MELVAL.VELCHE(/2))
  345. IGMN=MIN(IC,MELVAL.VELCHE(/1))
  346. MELVAL.VELCHE(IGMN,IBMN)=DJAC*XU(3)
  347. ENDIF
  348. 4002 CONTINUE
  349. 4000 CONTINUE
  350.  
  351. GOTO 520
  352. C
  353. C ================ FORMULATION COQUE EPAISSE ====================
  354. C
  355. C
  356. ELSE IF(MFR.EQ.5) THEN
  357. SEGACT MINTE1
  358. NBPGA1=MINTE1.POIGAU(/1)
  359. NBN1 =MINTE1.SHPTOT(/2)
  360. SEGINI TR1
  361. C
  362. C UNE PETITE HORREUR ON CONSIDERE LES EPAISSEURS CONSTANTES
  363. C
  364. DO 5010 IC=1,NBNN
  365. TH(IC)=UN
  366. 5010 CONTINUE
  367. DO 5000 IB=1,NBELEM
  368. *--------------Calcul de la normale a l'élément
  369. IREF1 = (IDIM + 1)*(MELEME.NUM(1, IB) - 1)
  370. * IREF2 = (IDIM + 1)*(MELEME.NUM(2, IB) - 1)
  371. * bp : les EF de coque epaisse etant quadratiques (coq6 et coq8), on
  372. * prend les noeuds "coins" pour eviter pb avec les noeuds 1,2,3 si courbures
  373. IREF2 = (IDIM + 1)*(MELEME.NUM(3, IB) - 1)
  374. DO 8 IC = 1, IDIM
  375. 8 XU(IC) = XCOOR(IREF2+IC)-XCOOR(IREF1+IC)
  376. XNORU = 0.
  377. DO 11 IC = 1, IDIM
  378. 11 XNORU = XNORU + XU(IC)*XU(IC)
  379. XNORU = SQRT(XNORU)
  380. DO 12 IC = 1, IDIM
  381. 12 XU(IC) = XU(IC)/XNORU
  382. IF (IDIM .EQ. 2) THEN
  383. XW(1) = -XU(2)
  384. XW(2) = XU(1)
  385. ELSE
  386. * IN = 3
  387. IN = 5
  388. 13 IREF3 = (IDIM + 1)*(MELEME.NUM(IN, IB) - 1)
  389. DO 14 IC = 1, IDIM
  390. 14 XV(IC) = XCOOR(IREF3 + IC) - XCOOR(IREF1 + IC)
  391. XNORV = 0.
  392. DO 15 IC = 1, IDIM
  393. 15 XNORV = XNORV + XV(IC)*XV(IC)
  394. XNORV = SQRT(XNORV)
  395. DO 16 IC = 1, IDIM
  396. 16 XV(IC) = XV(IC)/XNORV
  397. XW(1) = XU(2)*XV(3) - XU(3)*XV(2)
  398. XW(2) = XU(3)*XV(1) - XU(1)*XV(3)
  399. XW(3) = XU(1)*XV(2) - XU(2)*XV(1)
  400. XNORW = 0.
  401. DO 17 IC = 1, IDIM
  402. 17 XNORW = XNORW + XW(IC)*XW(IC)
  403. XNORW = SQRT(XNORW)
  404. IF (XNORW .LT. 1.E-4) THEN
  405. if(IN.LT.NBNN) then
  406. IN = IN + 1
  407. GOTO 13
  408. else
  409. write(6,*) 'Difficultes pour etablir la normale de'
  410. write(6,*) 'l element',IB
  411. write(6,*) 'Verifiez votre maillage'
  412. GOTO 9990
  413. endif
  414. ENDIF
  415. DO 18 IC = 1, IDIM
  416. 18 XW(IC) = XW(IC)/XNORW
  417. ENDIF
  418. *--------------Fin du calcul de la normale a l'élément
  419. IF (INORM .EQ. 0) THEN
  420. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  421. C
  422. CALL CQ8LOC(XE,NBN1,MINTE1.SHPTOT,TXR,IRR)
  423. ENDIF
  424. C
  425. DO 5002 IC=1,NBPGAU
  426. IF (INORM .EQ. 1) THEN
  427. DJAC = 1.
  428. ELSE
  429. E=DZEGAU(IC)
  430. CALL COQ8JC(IC,NBN1,E,XE,TH,TXR,SHPTOT,XJ,DJAC,IRR)
  431. ENDIF
  432. MPTVAL=IVAJAC
  433. MELVAL = IVAL(1)
  434. IBMN=MIN(IB, MELVAL.VELCHE(/2))
  435. IGMN=MIN(IC, MELVAL.VELCHE(/1))
  436. MELVAL.VELCHE(IGMN,IBMN)=DJAC*XW(1)
  437. MELVAL = IVAL(2)
  438. IBMN=MIN(IB, MELVAL.VELCHE(/2))
  439. IGMN=MIN(IC, MELVAL.VELCHE(/1))
  440. MELVAL.VELCHE(IGMN,IBMN)=DJAC*XW(2)
  441. IF (IDIM .EQ. 3) THEN
  442. MELVAL = IVAL(3)
  443. IBMN=MIN(IB, MELVAL.VELCHE(/2))
  444. IGMN=MIN(IC, MELVAL.VELCHE(/1))
  445. MELVAL.VELCHE(IGMN,IBMN)=DJAC*XW(3)
  446. ENDIF
  447. 5002 CONTINUE
  448. 5000 CONTINUE
  449. GOTO 520
  450. ENDIF
  451. C---------------------------------------------------------------------
  452. C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  453. C---------------------------------------------------------------------
  454. C
  455. 520 CONTINUE
  456. MPTVAL=IVAJAC
  457. DO 515 IO=1,NJAC
  458. IF(IVAL(IO).NE.0) THEN
  459. MELVAL=IVAL(IO)
  460. SEGDES MELVAL
  461. ENDIF
  462. 515 CONTINUE
  463. SEGSUP MPTVAL
  464. C
  465. SEGDES MINTE
  466. * SEGSUP INFO
  467. C
  468. SEGDES IMODEL
  469. SEGDES MELEME
  470. SEGDES MCHAML
  471. C
  472. IF (MFR.EQ.5) THEN
  473. SEGDES MINTE1,TR1
  474. ENDIF
  475. C
  476. SEGSUP TRA
  477. C
  478. 500 CONTINUE
  479. SEGDES MMODEL
  480. SEGDES MCHELM
  481. RETURN
  482. C
  483. C
  484. 9990 CONTINUE
  485. *
  486. C-------------------------------------------------------------------
  487. C ERREUR DANS UNE ZONE , DESACTIVATION ET RETOUR
  488. C-------------------------------------------------------------------
  489. *
  490. *
  491. *
  492. MPTVAL=IVAJAC
  493. DO 9993 IO=1,NJAC
  494. IF (IVAL(IO).NE.0) THEN
  495. MELVAL=IVAL(IO)
  496. SEGDES MELVAL
  497. ENDIF
  498. 9993 CONTINUE
  499. SEGSUP MPTVAL
  500. *
  501. *
  502. *
  503. SEGDES MELEME
  504. SEGDES IMODEL
  505. SEGDES MCHAML
  506. C
  507. SEGDES MMODEL
  508. SEGDES MCHELM
  509. SEGDES MINTE
  510. * SEGSUP INFO
  511. RETURN
  512. END
  513.  
  514.  
  515.  
  516.  
  517.  
  518.  
  519.  
  520.  
  521.  
  522.  
  523.  
  524.  
  525.  
  526.  
  527.  
  528.  
  529.  

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