Télécharger hook2d.eso

Retour à la liste

Numérotation des lignes :

  1. C HOOK2D SOURCE FD218221 17/04/24 21:15:09 9417
  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.  
  484.  
  485.  
  486.  
  487.  
  488.  
  489.  
  490.  
  491.  
  492.  
  493.  
  494.  
  495.  
  496.  
  497.  
  498.  
  499.  
  500.  
  501.  
  502.  
  503.  
  504.  
  505.  
  506.  
  507.  
  508.  
  509.  

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