Télécharger hook2d.eso

Retour à la liste

Numérotation des lignes :

  1. C HOOK2D SOURCE CB215821 17/10/12 21:15:17 9589
  2. SUBROUTINE HOOK2D(IPMODE,CMATE,INAT,MFR,IVAMAT,NMATT,IVACAR,
  3. 1 NCARR,NPINT,IVARI,NVART,IVAHOO,KCAS,NBPGAU,
  4. 2 LHOOK,LHOO2,LW,LASURF,IPORE,IRET)
  5. C_______________________________________________________________________
  6. C
  7. C Calcul de la matrice de HOOKE
  8. C
  9. C Entr{es:
  10. C ________
  11. C
  12. C IPMODE Pointeur sur un segment imodel
  13. C CMATE Type du mat{riau (isotrope, orthotrope .....)
  14. C INAT Numero de plasticite
  15. C MFR Numero de formulation
  16. C IVAMAT Pointeur sur un tableau de MELVAL de MATERIAU
  17. C NMATT Nombre de composantes de materiau
  18. C IVACAR Pointeur sur un tableau de MELVAL de CARACTERISTIQUES
  19. C NCARR Nombre de composantes de caracteristiques
  20. C NPINT Nombre de points d integration
  21. C IVARI Pointeur sur un tableau de MELVAL de VARIABLES INTERNES
  22. C NVART Nombre de composantes de variables internes
  23. C IVAHOO Pointeur sur le MELVAL de HOOKE
  24. C NBPGAU Nombre de points d integration
  25. C LHOOK Taille de la matrice de HOOKE
  26. C LHOO2 Taille au carre de la matrice de HOOKE
  27. C LW Taille du tableau de travail WORK
  28. C LASURF 1 si on veut la matrice en surface de ref, 0 sinon
  29. C IPORE dimension pour milieux poreux
  30. C
  31. C Sorties:
  32. C ________
  33. C
  34. C IRET=1 OU 0 suivant succes ou pas
  35. C
  36. C
  37. C CODE L EBERSOLT MAI 84
  38. C
  39. C Passage aux nouveaux CHAMELEMs par I.Monnier le 18.06.90
  40. C ADDITION DES MATERIAUX ORTHOTROPE ET ANISOTROPE
  41. C PAR P.DOWLATYARI DEC. 90
  42. C_______________________________________________________________________
  43. C
  44. IMPLICIT INTEGER(I-N)
  45. IMPLICIT REAL*8(A-H,O-Z)
  46. -INC SMCHAML
  47. -INC SMLREEL
  48. -INC CCHAMP
  49. -INC CCOPTIO
  50. -INC SMMODEL
  51. -INC SMELEME
  52. -INC SMCOORD
  53. -INC SMINTE
  54. *
  55. SEGMENT MPTVAL
  56. INTEGER IPOS(NS) ,NSOF(NS)
  57. INTEGER IVAL(NCOSOU)
  58. CHARACTER*16 TYVAL(NCOSOU)
  59. ENDSEGMENT
  60. *
  61. SEGMENT WRK2
  62. REAL*8 XE(3,NBNN),TXR(IDIM,IDIM)
  63. REAL*8 XLOC(3,3),XGLOB(3,3)
  64. REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  65. ENDSEGMENT
  66. *
  67. SEGMENT WRK4
  68. REAL*8 SHPWRK(6,NBNN), BGENE(NSTRS,LRE)
  69. REAL*8 BPSS(3,3), XEL(3,NBNN)
  70. ENDSEGMENT
  71. *
  72. SEGMENT TRAV
  73. REAL*8 VALCAR(LW),VALMAT(NMATT),VAR(NVART)
  74. REAL*8 DDHOOK(LHOOK,LHOOK),DDHOMU(LHOOK,LHOOK)
  75. REAL*8 COBMA(LHOOK)
  76. ENDSEGMENT
  77. C
  78. DIMENSION CRIGI(12),CMASS(12),S(20)
  79. CHARACTER*8 CMATE
  80. PARAMETER(XZER=0.D0,X774=.774596669241483D0)
  81. C
  82. IRET=1
  83. IGAU=0
  84. IB =0
  85. IMODEL=IPMODE
  86. MELE=NEFMOD
  87. C
  88. C RECUPERATION DES TAILLES DE TABLEAUX
  89. C
  90. MELVAL=IVAHOO
  91. NBPTEL=IELCHE(/1)
  92. NEL =IELCHE(/2)
  93. MPTVAL=IVAMAT
  94. NBGMAT = 0
  95. NELMAT = 0
  96. DO 1000 IM=1,NMATT
  97. IF(IVAL(IM).NE.0)THEN
  98. MELVAL=IVAL(IM)
  99. IF(CMATE.EQ.'SECTION')THEN
  100. NBGMAT=MAX(NBGMAT,IELCHE(/1))
  101. NELMAT=MAX(NELMAT,IELCHE(/2))
  102. ELSE
  103. NBGMAT=MAX(NBGMAT,VELCHE(/1))
  104. NELMAT=MAX(NELMAT,VELCHE(/2))
  105. ENDIF
  106. ENDIF
  107. 1000 CONTINUE
  108. MPTVAL=IVACAR
  109. DO 1001 IO=1,NCARR
  110. IF(IVAL(IO).NE.0)THEN
  111. MELVAL=IVAL(IO)
  112. IF (CMATE.EQ.'SECTION') THEN
  113. NBGMAT=MAX(NBGMAT,IELCHE(/1))
  114. NELMAT=MAX(NELMAT ,IELCHE(/2))
  115. ELSE
  116. NBGMAT=MAX(NBGMAT,VELCHE(/1))
  117. NELMAT=MAX(NELMAT ,VELCHE(/2))
  118. ENDIF
  119. ENDIF
  120. 1001 CONTINUE
  121. IF (IVARI.NE.0) THEN
  122. MPTVAL=IVARI
  123. DO 1002 IO=1,NVART
  124. IF(IVAL(IO).NE.0)THEN
  125. MELVAL=IVAL(IO)
  126. IF (CMATE.EQ.'SECTION') THEN
  127. NBGMAT=MAX(NBGMAT,IELCHE(/1))
  128. NELMAT=MAX(NELMAT ,IELCHE(/2))
  129. ELSE
  130. NBGMAT=MAX(NBGMAT,VELCHE(/1))
  131. NELMAT=MAX(NELMAT ,VELCHE(/2))
  132. ENDIF
  133. ENDIF
  134. 1002 CONTINUE
  135. ENDIF
  136. C
  137. C INITIALISATION DES TABLEAUX DE TRAVAIL
  138. C
  139. IF(MFR.EQ.15.AND.NBPGAU.EQ.1) THEN
  140. DO 10 I=1,NBPGAU
  141. S(I)= XZER
  142. 10 CONTINUE
  143. ELSE IF(MFR.EQ.15.AND.NBPGAU.EQ.3) THEN
  144. DO 11 I=1,NBPGAU
  145. S(1)=-X774
  146. S(2)= XZER
  147. S(3)= X774
  148. 11 CONTINUE
  149. ENDIF
  150. *
  151. NMAT1=NMATT
  152. * cette sequence est presente car la troisieme composante
  153. * (eventuellement) obligatoire est la septieme composante du materiau
  154. IF(INAT.EQ.26) NMATT=NMATT+4
  155. SEGINI TRAV
  156. *
  157. IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  158. 1 CMATE.EQ.'UNIDIREC').OR.(MFR.EQ.55)) THEN
  159. C RENSEIGNEMENTS SUR LE MAILLAGE
  160. MELEME=IMAMOD
  161. SEGACT MELEME
  162. NBNN=NUM(/1)
  163. SEGINI WRK2
  164. *
  165. IF(MFR.EQ.55)THEN
  166. LRE=NBNN*IDIM
  167. NSTRS=LHOOK
  168. SEGINI,WRK4
  169. ENDIF
  170. *
  171. ENDIF
  172. C
  173. C
  174. C
  175. IF (((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  176. 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.33))
  177. 1 .OR.(MFR.EQ.55)) THEN
  178. C
  179. C RENSEIGNEMENTS SUR LE MAILLAGE
  180. C
  181. NBNO=NBNN
  182. IF(MFR.EQ.33) NBNO=IPORE
  183. *
  184. * RECUPERATION DES FONCTIONS DE FORME ET LEURS DERIVEES AU CENTRE DE
  185. * L'ELEMENT POUR LE CALCUL DES AXES LOCAUX
  186. IELE=NUMGEO(MELE)
  187. CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPT1,IRT1)
  188. MINTE2=IPT1
  189. SEGACT MINTE2
  190. ENDIF
  191. C
  192. C Boucle sur les elements
  193. C
  194. DO 1100 IB=1,NEL
  195. C
  196. IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  197. 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.33)) THEN
  198. C
  199. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  200. C
  201. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  202. C
  203. C CALCUL DES AXES LOCAUX
  204. C
  205. NBSH=MINTE2.SHPTOT(/2)
  206. CALL RLOCAL(XE,MINTE2.SHPTOT,NBSH,NBNN,TXR)
  207. if (nbsh.eq.-1) then
  208. call erreur(525)
  209. return
  210. endif
  211. ENDIF
  212. C
  213. C Boucle sur les points
  214. C
  215. DO 1100 IGAU=1,NBPTEL
  216. C
  217. MPTVAL=IVAMAT
  218. DO 1005 IM=1,NMAT1
  219. IF (IVAL(IM).NE.0) THEN
  220. MELVAL=IVAL(IM)
  221. IBMN=MIN(IB ,VELCHE(/2))
  222. IGMN=MIN(IGAU,VELCHE(/1))
  223. VALMAT(IM)=VELCHE(IGMN,IBMN)
  224. ELSE
  225. VALMAT(IM)=0.D0
  226. ENDIF
  227. 1005 CONTINUE
  228. *
  229. * cette sequence est presente car la troisieme composante
  230. * (eventuellement) obligatoire est la septieme composante du materiau
  231. IF(INAT.EQ.26) THEN
  232. VALMAT(7)=VALMAT(3)
  233. DO 1006 ICOMP=3,6
  234. VALMAT(ICOMP)=0.D0
  235. 1006 CONTINUE
  236. ENDIF
  237. C
  238. IF(INAT.EQ.26.OR.INAT.EQ.29.OR.INAT.EQ.30.OR.
  239. . INAT.EQ.62.OR.INAT.EQ.64.OR.INAT.EQ.65.OR.INAT.EQ.118) THEN
  240. MPTVAL=IVARI
  241. DO 1007 IM=1,NVART
  242. IF (IVAL(IM).NE.0) THEN
  243. MELVAL=IVAL(IM)
  244. IBMN=MIN(IB ,VELCHE(/2))
  245. IGMN=MIN(IGAU,VELCHE(/1))
  246. VAR(IM)=VELCHE(IGMN,IBMN)
  247. ELSE
  248. VAR(IM)=0.D0
  249. ENDIF
  250. 1007 CONTINUE
  251. ENDIF
  252. C
  253.  
  254. IF(MFR.EQ.61)THEN
  255. DO ICOMP=1,NCARR
  256. MPTVAL=IVACAR
  257. MELVAL=IVAL(ICOMP)
  258. IF (MELVAL.NE.0) THEN
  259. IBMN=MIN(IB ,VELCHE(/2))
  260. IGMN=MIN(IGAU,VELCHE(/1))
  261. VALCAR(ICOMP)=VELCHE(IGMN,IBMN)
  262. ELSE
  263. VALCAR(ICOMP)=0.D0
  264. ENDIF
  265. ENDDO
  266. ENDIF
  267.  
  268. C
  269. IF(MFR.EQ.7.OR.MFR.EQ.13.OR.MFR.EQ.15.
  270. 1 OR.MFR.EQ.17) THEN
  271. C
  272. C ON CHERCHE LES CARACTERISTIQUES DE L ELEMENT IB
  273. C
  274. IF(CMATE.EQ.'SECTION') THEN
  275. C
  276. MPTVAL=IVAMAT
  277. MELVAL=IVAL(1)
  278. IBMN=MIN(IB ,IELCHE(/2))
  279. IGMN=MIN(IGAU,IELCHE(/1))
  280. IPMODL=IELCHE(IGMN,IBMN)
  281. MELVAL=IVAL(2)
  282. IBMN=MIN(IB ,IELCHE(/2))
  283. IGMN=MIN(IGAU,IELCHE(/1))
  284. IPCAR=IELCHE(IGMN,IBMN)
  285. CALL FRIGIE(IPMODL,IPCAR,CRIGI,CMASS)
  286. C
  287. ELSEIF (MFR.EQ.15) THEN
  288. C
  289. IE=1
  290. DO 7030 IC=1,3,2
  291. MPTVAL=IVACAR
  292. DO 7030 ICOMP=1,NCARR
  293. MELVAL=IVAL(ICOMP)
  294. IF (MELVAL.NE.0) THEN
  295. IGMN=MIN(IC,VELCHE(/1))
  296. IBMN=MIN(IB,VELCHE(/2))
  297. VALCAR(IE)=VELCHE(IGMN,IBMN)
  298. ELSE
  299. VALCAR(IE)=0.D0
  300. ENDIF
  301. IE=IE+1
  302. 7030 CONTINUE
  303. C
  304. ELSE
  305. C
  306. DO 1010 ICOMP=1,NCARR
  307. MPTVAL=IVACAR
  308. MELVAL=IVAL(ICOMP)
  309. IF (MELVAL.NE.0) THEN
  310. IBMN=MIN(IB ,VELCHE(/2))
  311. IGMN=MIN(IGAU,VELCHE(/1))
  312. VALCAR(ICOMP)=VELCHE(IGMN,IBMN)
  313. ELSE
  314. VALCAR(ICOMP)=0.D0
  315. ENDIF
  316. 1010 CONTINUE
  317. ENDIF
  318. ENDIF
  319. C
  320. IF(MFR.EQ.27.OR.MFR.EQ.49) THEN
  321. C
  322. C ON CHERCHE LA SECTION DE L'ELEMENT IB
  323. C
  324. MPTVAL=IVACAR
  325. MELVAL=IVAL(1)
  326. IF (MELVAL.NE.0) THEN
  327. IBMN=MIN(IB ,VELCHE(/2))
  328. IGMN=MIN(IGAU,VELCHE(/1))
  329. SECT=VELCHE(IGMN,IBMN)
  330. ELSE
  331. SECT=0.D0
  332. ENDIF
  333. ENDIF
  334. C
  335. C ON CHERCHE L'EPAISSEUR DU JOINT GENERALISE IB
  336. C
  337. IF(MFR.EQ.55) THEN
  338. MPTVAL=IVACAR
  339. MELVAL=IVAL(1)
  340. IF (MELVAL.NE.0) THEN
  341. IBMN=MIN(IB ,VELCHE(/2))
  342. IGMN=MIN(IGAU,VELCHE(/1))
  343. EPAIST=VELCHE(IGMN,IBMN)
  344. ELSE
  345. EPAIST=0.D0
  346. ENDIF
  347. C
  348. IF(EPAIST.EQ.0.D0) THEN
  349. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  350. IF(MELE.EQ.170)THEN
  351. CALL JO2LOC(XE,MINTE2.SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  352. CALL BJO2GN(IGAU,MFR,IFOUR,NIFOUR,XE,XEL,BPSS,
  353. . MINTE2.SHPTOT,SHPWRK,EPAIST,BGENE,DJAC,XDPGE,YDPGE,IERT)
  354. ELSEIF(MELE.EQ.171)THEN
  355. CALL JT3LOC(XE,MINTE2.SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  356. CALL BJT3G(IGAU,MFR,IFOUR,NIFOUR,XE,XEL,BPSS,
  357. . MINTE2.SHPTOT,SHPWRK,EPAIST,BGENE,DJAC,IERT)
  358. ELSEIF(MELE.EQ.172)THEN
  359. CALL JO4LOC(XE,MINTE2.SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  360. CALL BJO4G(IGAU,XE,XEL,BPSS,MINTE2.SHPTOT,SHPWRK,EPAIST,
  361. . BGENE,DJAC,IERT)
  362. ENDIF
  363. ENDIF
  364. ENDIF
  365.  
  366. C
  367. C Prise en compte de l'epaisseur et de l'excentrement
  368. C dans le cas des coques minces avec ou sans cisaillement
  369. C transverse
  370. C
  371. IF ((CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ORTHOTRO'.
  372. 1 OR.CMATE.EQ.'UNIDIREC').AND.
  373. 2 (MFR.EQ.3.OR.MFR.EQ.9)) THEN
  374. MPTVAL=IVACAR
  375. MELVAL=IVAL(1)
  376. IF (MELVAL.NE.0) THEN
  377. IBMN=MIN(IB ,VELCHE(/2))
  378. IGMN=MIN(IGAU,VELCHE(/1))
  379. EPAIST=VELCHE(IGMN,IBMN)
  380. ELSE
  381. CALL ERREUR(527)
  382. IRET=0
  383. GOTO 9000
  384. ENDIF
  385. C
  386. IF(LASURF.EQ.0) THEN
  387. EXCEN = 0.D0
  388. ELSE
  389. MELVAL=IVAL(2)
  390. IF (MELVAL.NE.0) THEN
  391. IBMN=MIN(IB ,VELCHE(/2))
  392. IGMN=MIN(IGAU,VELCHE(/1))
  393. EXCEN=VELCHE(IGMN,IBMN)
  394. ELSE
  395. EXCEN=0.D0
  396. ENDIF
  397. ENDIF
  398. ENDIF
  399.  
  400. C_______________________________________________________________________
  401. C
  402. C TRAITEMENT SUIVANT TYPE DE MATERIAU
  403. C_______________________________________________________________________
  404. C
  405. IF (CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ZONE_COH') THEN
  406. CALL HOOKIS(VALMAT,VALCAR,VAR,MFR,IB,IGAU,EXCEN,EPAIST,
  407. + INAT,MELE,NPINT,IFOUR,KCAS,NBGMAT,NELMAT,
  408. + S,SECT,LHOOK,DDHOMU,DDHOOK,
  409. + COBMA,XMOB,IRET)
  410. C
  411. ELSE IF (CMATE.EQ.'ORTHOTRO') THEN
  412. CALL HOOKOR(VALMAT,IB,IGAU,MFR,EXCEN,EPAIST,
  413. + MELE,NPINT,IFOUR,KCAS,NBGMAT,NELMAT,SECT,LHOOK,
  414. + TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,DDHOOK,
  415. + COBMA,XMOB,IRET)
  416. C
  417. ELSE IF (CMATE.EQ.'ANISOTRO') THEN
  418. CALL HOOKAN(VALMAT,IB,IGAU,MFR,IFOUR,KCAS,NBGMAT,NELMAT,
  419. + SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOOK,
  420. + MELE,COBMA,XMOB,IRET)
  421. C
  422. ELSE IF (CMATE.EQ.'UNIDIREC') THEN
  423. CALL HOOKUN(VALMAT,IB,IGAU,MFR,EXCEN,EPAIST,
  424. + MELE,NPINT,IFOUR,KCAS,NBGMAT,NELMAT,SECT,LHOOK,
  425. + TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,DDHOOK,
  426. + COBMA,XMOB,IRET)
  427. C
  428. ELSE IF (CMATE.EQ.'HOMOGENE') THEN
  429. CALL HOOKHO(VALMAT,IB,IGAU,MFR,NBGMAT,NELMAT,SECT,
  430. + LHOOK,DDHOOK,IRET)
  431. C
  432. ELSE IF (CMATE.EQ.'SECTION') THEN
  433. CALL HOOKSE(VALMAT,IB,IGAU,MFR,CRIGI,IFOUR,
  434. + NBGMAT,NELMAT,SECT,LHOOK,DDHOOK,IRET)
  435. C
  436. ENDIF
  437. C
  438. IF (IRET.EQ.0) THEN
  439. IF (MFR.EQ.3.AND.NPINT.NE.0) THEN
  440. CALL ERREUR(251)
  441. ELSE
  442. MOTERR(1:8)=NOMFR(MFR/2+1)
  443. CALL ERREUR(193)
  444. ENDIF
  445. GOTO 1200
  446. ENDIF
  447. C
  448.  
  449. C
  450. C REMPLISSAGE DU SEGMENT IVAHOO
  451. C
  452. JG=LHOO2
  453. SEGINI,MLREEL
  454. MELVAL=IVAHOO
  455. IELCHE(IGAU,IB)=MLREEL
  456. KO=0
  457. DO 1015 IO=1,LHOOK
  458. DO 1015 JO=1,LHOOK
  459. KO=KO+1
  460. PROG(KO)=DDHOOK(IO,JO)
  461. 1015 CONTINUE
  462. SEGDES,MLREEL
  463. 1100 CONTINUE
  464. C
  465. 1200 CONTINUE
  466. IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  467. 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.33)) THEN
  468. ** SEGDES MINTE2
  469. ENDIF
  470. *
  471. 9000 CONTINUE
  472. IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  473. 1 CMATE.EQ.'UNIDIREC')) THEN
  474. ** SEGDES MELEME
  475. SEGSUP WRK2
  476. ENDIF
  477. IF (MFR.EQ.55) SEGSUP WRK4
  478. SEGSUP TRAV
  479. RETURN
  480. END
  481.  
  482.  
  483.  

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