Télécharger jacono.eso

Retour à la liste

Numérotation des lignes :

  1. C JACONO SOURCE CB215821 19/08/20 21:18:43 10287
  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. SEGSUP MCHELM
  113. IRET=0
  114. RETURN
  115. ENDIF
  116. INFO=IPINF
  117. MELE =INFELL(1)
  118. MFR =INFELL(13)
  119. MINTE=INFELL(11)
  120. MINTE1=INFELL(12)
  121. segsup info
  122. else
  123. MELE =INFELE(1)
  124. MFR =INFELE(13)
  125. MINTE=INFMOD(7)
  126. MINTE1=INFMOD(8)
  127. endif
  128. C
  129. INFCHE(ISOUS,1)=0
  130. INFCHE(ISOUS,2)=0
  131. INFCHE(ISOUS,3)=NHRM
  132. INFCHE(ISOUS,4)=MINTE
  133. INFCHE(ISOUS,5)=0
  134. INFCHE(ISOUS,6)=5
  135. C
  136. C INITIALISATION DE MINTE
  137. C
  138. SEGACT MINTE
  139. NBPGAU=POIGAU(/1)
  140. C
  141. C ACTIVATION DU MELEME
  142. C
  143. SEGACT MELEME
  144. NBNN =NUM(/1)
  145. NBELEM=NUM(/2)
  146. C
  147. C RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER
  148. C
  149. IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9 .OR. MFR.EQ.77) THEN
  150. N1PTEL=NBPGAU
  151. N1EL=NBELEM
  152. ELSEIF(MFR.EQ.7 .OR. MFR.EQ.13) THEN
  153. N1PTEL=NBPGAU
  154. N1EL=NBELEM
  155. ELSE
  156. N1PTEL = 0
  157. N1EL = 0
  158. ENDIF
  159. C
  160. C CREATION DU MCHAML DE LA SOUS ZONE
  161. C
  162. NJAC=IDIM
  163. N2 = IDIM
  164. SEGINI MCHAML
  165. ICHAML(ISOUS)=MCHAML
  166. NS=1
  167. NCOSOU=NJAC
  168. SEGINI MPTVAL
  169. IVAJAC=MPTVAL
  170. C
  171. C 2 OU 3 COMPOSANTES
  172. C
  173. ICOMP=1
  174. IF (IFOUR.EQ.0.OR.IFOUR.EQ.1) THEN
  175. NOMCHE(ICOMP)='VR '
  176. ELSE
  177. NOMCHE(ICOMP)='VX '
  178. ENDIF
  179. TYPCHE(ICOMP)='REAL*8'
  180. N2PTEL=0
  181. N2EL=0
  182. SEGINI MELVA1
  183. IELVAL(ICOMP)=MELVA1
  184. IVAL(ICOMP)=MELVA1
  185. C
  186. ICOMP=2
  187. IF (IFOUR.EQ.0.OR.IFOUR.EQ.1) THEN
  188. NOMCHE(ICOMP)='VZ '
  189. ELSE
  190. NOMCHE(ICOMP)='VY '
  191. ENDIF
  192. TYPCHE(ICOMP)='REAL*8'
  193. N2PTEL=0
  194. N2EL=0
  195. SEGINI MELVA2
  196. IELVAL(ICOMP)=MELVA2
  197. IVAL(ICOMP)=MELVA2
  198. C
  199. IF (IDIM .EQ. 3) THEN
  200. ICOMP=3
  201. NOMCHE(ICOMP)='VZ '
  202. TYPCHE(ICOMP)='REAL*8'
  203. N2PTEL=0
  204. N2EL=0
  205. SEGINI MELVA3
  206. IELVAL(ICOMP)=MELVA3
  207. IVAL(ICOMP)=MELVA3
  208. ENDIF
  209. C
  210. 44 CONTINUE
  211. C
  212. SEGINI TRA
  213. C
  214. C ================ FORMULATION MASSIVE =======================
  215. C
  216. C
  217. IF(MFR.EQ.1.OR.MFR.EQ.33) THEN
  218. GOTO 520
  219. C
  220. C ================ FORMULATION COQUE MINCE =====================
  221. C
  222. C
  223. ELSE IF(MFR.EQ.3.OR.MFR.EQ.9 .OR. MFR.EQ.77) THEN
  224. IDI2=IDIM-1
  225. DO 3000 IB=1,NBELEM
  226. *--------------Calcul de la normale a l'élément
  227. IREF1 = (IDIM + 1)*(MELEME.NUM(1, IB) - 1)
  228. IREF2 = (IDIM + 1)*(MELEME.NUM(2, IB) - 1)
  229. DO 28 IC = 1, IDIM
  230. 28 XU(IC) = XCOOR(IREF2+IC)-XCOOR(IREF1+IC)
  231. XNORU = 0.
  232. DO 31 IC = 1, IDIM
  233. 31 XNORU = XNORU + XU(IC)*XU(IC)
  234. XNORU = SQRT(XNORU)
  235. DO 32 IC = 1, IDIM
  236. 32 XU(IC) = XU(IC)/XNORU
  237. IF (IDIM .EQ. 2) THEN
  238. XW(1) = -XU(2)
  239. XW(2) = XU(1)
  240. ELSE
  241. IN = 3
  242. 33 IREF3 = (IDIM + 1)*(MELEME.NUM(IN, IB) - 1)
  243. DO 34 IC = 1, IDIM
  244. 34 XV(IC) = XCOOR(IREF3+IC)-XCOOR(IREF1+IC)
  245. XNORV = 0.
  246. DO 35 IC = 1, IDIM
  247. 35 XNORV = XNORV + XV(IC)*XV(IC)
  248. XNORV = SQRT(XNORV)
  249. DO 36 IC = 1, IDIM
  250. 36 XV(IC) = XV(IC)/XNORV
  251. XW(1) = XU(2)*XV(3) - XU(3)*XV(2)
  252. XW(2) = XU(3)*XV(1) - XU(1)*XV(3)
  253. XW(3) = XU(1)*XV(2) - XU(2)*XV(1)
  254. XNORW = 0.
  255. DO 37 IC = 1, IDIM
  256. 37 XNORW = XNORW + XW(IC)*XW(IC)
  257. IF (XNORW .LT. 1.E-4) THEN
  258. IN = IN + 1
  259. if(IN.le.NBNN) GOTO 33
  260. ENDIF
  261. XNORW = SQRT(XNORW)
  262. IF(XNORW .LT.1.E-4) call erreur(345)
  263. DO 38 IC = 1, IDIM
  264. 38 XW(IC) = XW(IC)/XNORW
  265. ENDIF
  266. *--------------Fin du calcul de la normale a l'élément
  267. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  268. C
  269. IF(IDIM.EQ.2)THEN
  270. CALL VPAST2(XE,BPSS)
  271. ELSE IF(IDIM.EQ.3) THEN
  272. CALL VPAST(XE,BPSS)
  273. ENDIF
  274. CALL VCORL1(XE,XEL,BPSS,NBNN)
  275. DO 3002 IC=1,NBPGAU
  276. IF (INORM .EQ. 1) THEN
  277. DJAC = 1.
  278. ELSE
  279. DO 3003 ID=1,6
  280. DO 3003 IE=1,NBNN
  281. SHP(ID,IE)=SHPTOT(ID,IE,IC)
  282. 3003 CONTINUE
  283. CALL JACOBI(XEL,SHP,IDI2,NBNN,DJAC)
  284. ENDIF
  285. MPTVAL=IVAJAC
  286. MELVAL = IVAL(1)
  287. IBMN=MIN(IB, MELVAL.VELCHE(/2))
  288. IGMN=MIN(IC,MELVAL.VELCHE(/1))
  289. MELVAL.VELCHE(IGMN,IBMN)=DJAC*XW(1)
  290. MELVAL = IVAL(2)
  291. IBMN=MIN(IB, MELVAL.VELCHE(/2))
  292. IGMN=MIN(IC,MELVAL.VELCHE(/1))
  293. MELVAL.VELCHE(IGMN,IBMN)=DJAC*XW(2)
  294. IF (IDIM .EQ. 3) THEN
  295. MELVAL = IVAL(3)
  296. IBMN=MIN(IB, MELVAL.VELCHE(/2))
  297. IGMN=MIN(IC,MELVAL.VELCHE(/1))
  298. MELVAL.VELCHE(IGMN,IBMN)=DJAC*XW(3)
  299. ENDIF
  300. 3002 CONTINUE
  301. 3000 CONTINUE
  302. GOTO 520
  303. C
  304. C ================ FORMULATION POUTRE ET TUYAU ====================
  305. C
  306. C
  307. ELSE IF(MFR.EQ.7.OR.MFR.EQ.13) THEN
  308. IDI2=IDIM-1
  309. DO 4000 IB=1,NBELEM
  310. *-----------Calcul de la tangente a l'élément
  311. IREF1 = (IDIM + 1)*(MELEME.NUM(1, IB) - 1)
  312. IREF2 = (IDIM + 1)*(MELEME.NUM(2, IB) - 1)
  313. DO 41 IC = 1, IDIM
  314. 41 XU(IC) = XCOOR(IREF2+IC)-XCOOR(IREF1+IC)
  315. XNORU = 0.D0
  316. DO 42 IC = 1, IDIM
  317. 42 XNORU = XNORU + XU(IC)*XU(IC)
  318. XNORU = SQRT(XNORU)
  319. DO 43 IC = 1, IDIM
  320. 43 XU(IC) = XU(IC)/XNORU
  321. *-----------Fin du calcul de la tangente a l'élément
  322. *-----------Calcul de la tangente a l'élément en chaque point de Gauss
  323. c BP : On suppose le jacobien constant dans l'element (idem POUJAC.eso)
  324. C => on sort le calcul du jacobien de la boucle sur les points de Gauss.
  325. C Cela implique que la POUTre de Bernoulli n'est pas isoparamétrique...
  326. IF (INORM .EQ. 1) THEN
  327. DJAC = 1.D0
  328. ELSE
  329. DJAC = 1.D0/DBLE(NBPGAU)
  330. ENDIF
  331. DO 4002 IC=1,NBPGAU
  332. MPTVAL=IVAJAC
  333. MELVAL = IVAL(1)
  334. IBMN=MIN(IB, MELVAL.VELCHE(/2))
  335. IGMN=MIN(IC,MELVAL.VELCHE(/1))
  336. MELVAL.VELCHE(IGMN,IBMN)=DJAC*XU(1)
  337. MELVAL = IVAL(2)
  338. IBMN=MIN(IB, MELVAL.VELCHE(/2))
  339. IGMN=MIN(IC,MELVAL.VELCHE(/1))
  340. MELVAL.VELCHE(IGMN,IBMN)=DJAC*XU(2)
  341. IF (IDIM .EQ. 3) THEN
  342. MELVAL = IVAL(3)
  343. IBMN=MIN(IB, MELVAL.VELCHE(/2))
  344. IGMN=MIN(IC,MELVAL.VELCHE(/1))
  345. MELVAL.VELCHE(IGMN,IBMN)=DJAC*XU(3)
  346. ENDIF
  347. 4002 CONTINUE
  348. 4000 CONTINUE
  349.  
  350. GOTO 520
  351. C
  352. C ================ FORMULATION COQUE EPAISSE ====================
  353. C
  354. C
  355. ELSE IF(MFR.EQ.5) THEN
  356. SEGACT MINTE1
  357. NBPGA1=MINTE1.POIGAU(/1)
  358. NBN1 =MINTE1.SHPTOT(/2)
  359. SEGINI TR1
  360. C
  361. C UNE PETITE HORREUR ON CONSIDERE LES EPAISSEURS CONSTANTES
  362. C
  363. DO 5010 IC=1,NBNN
  364. TH(IC)=UN
  365. 5010 CONTINUE
  366. DO 5000 IB=1,NBELEM
  367. *--------------Calcul de la normale a l'élément
  368. IREF1 = (IDIM + 1)*(MELEME.NUM(1, IB) - 1)
  369. * IREF2 = (IDIM + 1)*(MELEME.NUM(2, IB) - 1)
  370. * bp : les EF de coque epaisse etant quadratiques (coq6 et coq8), on
  371. * prend les noeuds "coins" pour eviter pb avec les noeuds 1,2,3 si courbures
  372. IREF2 = (IDIM + 1)*(MELEME.NUM(3, IB) - 1)
  373. DO 8 IC = 1, IDIM
  374. 8 XU(IC) = XCOOR(IREF2+IC)-XCOOR(IREF1+IC)
  375. XNORU = 0.
  376. DO 11 IC = 1, IDIM
  377. 11 XNORU = XNORU + XU(IC)*XU(IC)
  378. XNORU = SQRT(XNORU)
  379. DO 12 IC = 1, IDIM
  380. 12 XU(IC) = XU(IC)/XNORU
  381. IF (IDIM .EQ. 2) THEN
  382. XW(1) = -XU(2)
  383. XW(2) = XU(1)
  384. ELSE
  385. * IN = 3
  386. IN = 5
  387. 13 IREF3 = (IDIM + 1)*(MELEME.NUM(IN, IB) - 1)
  388. DO 14 IC = 1, IDIM
  389. 14 XV(IC) = XCOOR(IREF3 + IC) - XCOOR(IREF1 + IC)
  390. XNORV = 0.
  391. DO 15 IC = 1, IDIM
  392. 15 XNORV = XNORV + XV(IC)*XV(IC)
  393. XNORV = SQRT(XNORV)
  394. DO 16 IC = 1, IDIM
  395. 16 XV(IC) = XV(IC)/XNORV
  396. XW(1) = XU(2)*XV(3) - XU(3)*XV(2)
  397. XW(2) = XU(3)*XV(1) - XU(1)*XV(3)
  398. XW(3) = XU(1)*XV(2) - XU(2)*XV(1)
  399. XNORW = 0.
  400. DO 17 IC = 1, IDIM
  401. 17 XNORW = XNORW + XW(IC)*XW(IC)
  402. XNORW = SQRT(XNORW)
  403. IF (XNORW .LT. 1.E-4) THEN
  404. if(IN.LT.NBNN) then
  405. IN = IN + 1
  406. GOTO 13
  407. else
  408. write(6,*) 'Difficultes pour etablir la normale de'
  409. write(6,*) 'l element',IB
  410. write(6,*) 'Verifiez votre maillage'
  411. GOTO 9990
  412. endif
  413. ENDIF
  414. DO 18 IC = 1, IDIM
  415. 18 XW(IC) = XW(IC)/XNORW
  416. ENDIF
  417. *--------------Fin du calcul de la normale a l'élément
  418. IF (INORM .EQ. 0) THEN
  419. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  420. C
  421. CALL CQ8LOC(XE,NBN1,MINTE1.SHPTOT,TXR,IRR)
  422. ENDIF
  423. C
  424. DO 5002 IC=1,NBPGAU
  425. IF (INORM .EQ. 1) THEN
  426. DJAC = 1.
  427. ELSE
  428. E=DZEGAU(IC)
  429. CALL COQ8JC(IC,NBN1,E,XE,TH,TXR,SHPTOT,XJ,DJAC,IRR)
  430. ENDIF
  431. MPTVAL=IVAJAC
  432. MELVAL = IVAL(1)
  433. IBMN=MIN(IB, MELVAL.VELCHE(/2))
  434. IGMN=MIN(IC, MELVAL.VELCHE(/1))
  435. MELVAL.VELCHE(IGMN,IBMN)=DJAC*XW(1)
  436. MELVAL = IVAL(2)
  437. IBMN=MIN(IB, MELVAL.VELCHE(/2))
  438. IGMN=MIN(IC, MELVAL.VELCHE(/1))
  439. MELVAL.VELCHE(IGMN,IBMN)=DJAC*XW(2)
  440. IF (IDIM .EQ. 3) THEN
  441. MELVAL = IVAL(3)
  442. IBMN=MIN(IB, MELVAL.VELCHE(/2))
  443. IGMN=MIN(IC, MELVAL.VELCHE(/1))
  444. MELVAL.VELCHE(IGMN,IBMN)=DJAC*XW(3)
  445. ENDIF
  446. 5002 CONTINUE
  447. 5000 CONTINUE
  448. GOTO 520
  449. ENDIF
  450. C---------------------------------------------------------------------
  451. C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  452. C---------------------------------------------------------------------
  453. C
  454. 520 CONTINUE
  455. MPTVAL=IVAJAC
  456. SEGSUP MPTVAL
  457. * SEGSUP INFO
  458. C
  459. SEGSUP TRA
  460. C
  461. 500 CONTINUE
  462. RETURN
  463. C
  464. C
  465. 9990 CONTINUE
  466. *
  467. C-------------------------------------------------------------------
  468. C ERREUR DANS UNE ZONE , DESACTIVATION ET RETOUR
  469. C-------------------------------------------------------------------
  470. *
  471. *
  472. *
  473. MPTVAL=IVAJAC
  474. SEGSUP MPTVAL
  475. *
  476. *
  477. *
  478. * SEGSUP INFO
  479. END
  480.  
  481.  
  482.  

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