Télécharger jacono.eso

Retour à la liste

Numérotation des lignes :

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

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