Télécharger hook2p.eso

Retour à la liste

Numérotation des lignes :

  1. C HOOK2P SOURCE CB215821 19/07/30 21:16:51 10273
  2. SUBROUTINE HOOK2P(IPMODL,IPCHE1,IPCHE2,LASURF,IPCHOO,IRET )
  3. C_______________________________________________________________________
  4. C
  5. C Entr{es:
  6. C ________
  7. C
  8. C IPMODL Pointeur sur un MMODEL
  9. C IPCHE1 Pointeur sur un MCHAML de caracteristiques
  10. C IPCHE2 Pointeur sur un MCHAML de variables internes(FACULTATIF)
  11. C LASURF Flag de pr{sence du mot cl{ REFE
  12. C
  13. C Sorties:
  14. C ________
  15. C
  16. C IPCHOO Pointeur sur un MCHAML de matrice de HOOKE
  17. C IRET 1 si tout OK 0 sinon
  18. C
  19. C CODE L.EBERSOLT SEPT 84
  20. C
  21. C Passage aux nouveaux CHAMELEMs par I.Monnier le 18.06.90
  22. C_______________________________________________________________________
  23. C
  24. IMPLICIT INTEGER(I-N)
  25. IMPLICIT REAL*8(A-H,O-Z)
  26.  
  27. -INC CCOPTIO
  28. -INC CCHAMP
  29. -INC CCGEOME
  30.  
  31. -INC SMCHAML
  32. -INC SMMODEL
  33. -INC SMLREEL
  34. -INC SMINTE
  35. *
  36. SEGMENT NOTYPE
  37. CHARACTER*16 TYPE(NBTYPE)
  38. ENDSEGMENT
  39. *
  40. SEGMENT MPTVAL
  41. INTEGER IPOS(NS) ,NSOF(NS)
  42. INTEGER IVAL(NCOSOU)
  43. CHARACTER*16 TYVAL(NCOSOU)
  44. ENDSEGMENT
  45. *
  46. CHARACTER*8 CMATE
  47. CHARACTER*(NCONCH) CONM
  48. PARAMETER ( NINF=3)
  49. INTEGER INFOS(NINF)
  50. LOGICAL lsupva,lsupma
  51. C
  52. IRET = 0
  53. lsupva=.false.
  54. lsupma=.false.
  55. *
  56. * VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUE
  57. *
  58. * AM 16/5/08 REDUCTION PRELABLE DU CHAMP SUR LE MODELE MECA
  59. *
  60. call reduaf(ipche1,ipmodl,ipche10,0,iretou,kerr)
  61. if (iretou.ne.1) call erreur(kerr)
  62. if (ierr.ne.0) return
  63. ipche1=ipche10
  64.  
  65. CALL QUESUP(IPMODL,IPCHE1,3,0,ISUP,IRETCA)
  66. IF (ISUP.GT.1) THEN
  67. call erreur(329)
  68. RETURN
  69. ENDIF
  70. *
  71. * VERIFICATION DU LIEU SUPPORT DU MCHAML DE VARIABLES INTERNES
  72. *
  73. IF (IPCHE2.NE.0) THEN
  74. call reduaf(ipche2,ipmodl,ipche20,0,iretou,kerr)
  75. if (iretou.ne.1) call erreur(kerr)
  76. if (ierr.ne.0) return
  77. ipche2=ipche20
  78. CALL QUESUP(IPMODL,IPCHE2,3,0,ISUP2,IRETVI)
  79. IF (ISUP2.GT.1) THEN
  80. call erreur(329)
  81. RETURN
  82. ENDIF
  83. ENDIF
  84. C
  85. C ACTIVATION DU MODELE
  86. C
  87. MMODEL=IPMODL
  88. SEGACT MMODEL
  89. NSOUS=KMODEL(/1)
  90. N1 = NSOUS
  91. C
  92. C ON NE TIENT PAS COMPTE D'UN EVENTUEL MODELE CHARGEMENT
  93. C
  94. DO III = 1,NSOUS
  95. IMODEL = KMODEL(III)
  96. SEGACT IMODEL
  97. IF (FORMOD(1).EQ.'CHARGEMENT') N1=N1-1
  98. C SEGDES IMODEL
  99. END DO
  100. C
  101. C INITIALISATION DU CHAPEAU DES MATRICES DE HOOKE
  102. C
  103. L1=16
  104. N3=6
  105. SEGINI MCHELM
  106. IPCHOO=MCHELM
  107. TITCHE='MATRICE DE HOOKE'
  108. IFOCHE=IFOUR
  109. C
  110. C BOUCLE SUR LES SOUS ZONES DU MAILLAGE
  111. C
  112. DO 100 ISOUS=1,N1
  113. IVAMAT=0
  114. IVACAR=0
  115. IVARI =0
  116. IVAHOO=0
  117. MOMATR=0
  118. MOCARA=0
  119. NVART =0
  120. IPMINT=0
  121. C
  122. C TRAITEMENT DU MODELE
  123. C
  124. IMODEL=KMODEL(ISOUS)
  125. SEGACT IMODEL
  126. MELE=NEFMOD
  127. IPMAIL=IMAMOD
  128. CONM =CONMOD
  129. C
  130. C CREATION DU TABLEAU INFOS
  131. C
  132. CALL IDENT(IPMAIL,CONM,IPCHE1,0,INFOS,IRTD)
  133. IF (IRTD.EQ.0) GOTO 9990
  134. C
  135. * NFOR=FORMOD(/2)
  136. * NMAT=MATMOD(/2)
  137. * CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT)
  138. CMATE = CMATEE
  139. MATE = IMATEE
  140. INAT = INATUU
  141. * IF (CMATE.EQ.' ') THEN
  142. * CALL ERREUR(251)
  143. * SEGSUP MCHELM
  144. * SEGDES MMODEL,IMODEL
  145. * RETURN
  146. * ENDIF
  147. C
  148. C COQUE INTEGREE OU PAS ?
  149. C
  150. IF(INFMOD(/1).NE.0)THEN
  151. NPINT=INFMOD(1)
  152. ELSE
  153. NPINT=0
  154. ENDIF
  155. C
  156. C REMPLISSAGE DE MCHELM DE HOOKE
  157. C
  158. IMACHE(ISOUS)=IPMAIL
  159. CONCHE(ISOUS)=CONMOD
  160. C
  161. C INFORMATION ELEMENT FINI
  162. C
  163. * CALL ELQUOI(MELE,0,3,IPINF,IMODEL)
  164. * IF (IERR.NE.0) THEN
  165. * SEGDES IMODEL,MMODEL
  166. * SEGSUP MCHELM
  167. * RETURN
  168. * ENDIF
  169. * INFO=IPINF
  170. NBPGAU=INFELE(6)
  171. LHOOK=INFELE(10)
  172. MFR =INFELE(13)
  173. IPPORE=0
  174. IF(MFR.EQ.33)IPPORE=NBNNE(NUMGEO(MELE))
  175. LW =INFELE(7)
  176. IPORE = INFELE(8)
  177. *
  178. * CAS DES DKT INTEGRES
  179. *
  180. IF (MFR.EQ.3.AND.NPINT.NE.0) LHOOK=4
  181. *
  182. LHOO2=LHOOK*LHOOK
  183. * MINTE=INFELE(11)
  184. MINTE=INFMOD(5)
  185. IPMINT=MINTE
  186. SEGACT,MINTE
  187. C
  188. INFCHE(ISOUS,1)=0
  189. INFCHE(ISOUS,2)=0
  190. INFCHE(ISOUS,3)=NIFOUR
  191. INFCHE(ISOUS,4)=IPMINT
  192. INFCHE(ISOUS,5)=0
  193. INFCHE(ISOUS,6)=3
  194. C
  195. C CREATION DU MCHAML DE HOOKE
  196. C
  197. IF((MELE.EQ.93.OR.MELE.EQ.87.OR.MELE.EQ.88).AND.
  198. & CMATE.NE.'ISOTROPE')THEN
  199. N2=3
  200. SEGINI MCHAML
  201. NOMCHE(1)='MAHO'
  202. NOMCHE(2)='V1X '
  203. NOMCHE(3)='V1Y '
  204. TYPCHE(1)='POINTEURLISTREEL'
  205. TYPCHE(2)='REAL*8'
  206. TYPCHE(3)='REAL*8'
  207. ELSE
  208. N2=1
  209. SEGINI MCHAML
  210. NOMCHE(1)='MAHO'
  211. TYPCHE(1)='POINTEURLISTREEL'
  212. ENDIF
  213. ICHAML(ISOUS)=MCHAML
  214. C
  215. * TRAITEMENT DES CHAMPS DE MATERIAU
  216. *
  217. lsupma=.true.
  218. IF (FORMOD(1).EQ.'MECANIQUE') THEN
  219. IF (CMATE.EQ.'ISOTROPE') THEN
  220. IF(INAT.EQ.26.AND.IPCHE2.NE.0) THEN
  221. NBROBL=3
  222. NBRFAC=0
  223. SEGINI NOMID
  224. MOMATR=NOMID
  225. LESOBL(1)='YOUN'
  226. LESOBL(2)='NU '
  227. LESOBL(3)='DC '
  228. ELSE IF (INAT.EQ.62.AND.IPCHE2.NE.0) THEN
  229. NBROBL=4
  230. NBRFAC=0
  231. SEGINI NOMID
  232. MOMATR=NOMID
  233. LESOBL(1)='YOUN'
  234. LESOBL(2)='NU '
  235. LESOBL(3)='F '
  236. LESOBL(4)='FC '
  237. ELSE IF (INAT.EQ.64.AND.IPCHE2.NE.0) THEN
  238. NBROBL=3
  239. NBRFAC=0
  240. SEGINI NOMID
  241. MOMATR=NOMID
  242. LESOBL(1)='YOUN'
  243. LESOBL(2)='NU '
  244. LESOBL(3)='FF '
  245. ELSE
  246. NBROBL=2
  247. NBRFAC=0
  248. SEGINI NOMID
  249. MOMATR=NOMID
  250. IF (MFR.EQ.35.OR.MFR.EQ.78) THEN
  251. LESOBL(1)='KS '
  252. LESOBL(2)='KN '
  253. ELSE IF(MFR.EQ.53) THEN
  254. NBROBL=1
  255. SEGADJ,NOMID
  256. LESOBL(1)='KS '
  257. ELSE
  258. LESOBL(1)='YOUN'
  259. LESOBL(2)='NU '
  260. ENDIF
  261. ENDIF
  262. NMATR=NBROBL
  263. NMATF=NBRFAC
  264. ELSEIF (CMATE.EQ.'ORTHOTRO') THEN
  265. IF (MFR.EQ.3) THEN
  266. * COQUES MINCES
  267. NBROBL=6
  268. NBRFAC=0
  269. SEGINI NOMID
  270. MOMATR=NOMID
  271. LESOBL(1)='YG1 '
  272. LESOBL(2)='YG2 '
  273. LESOBL(3)='NU12'
  274. LESOBL(4)='G12 '
  275. LESOBL(5)='V1X '
  276. LESOBL(6)='V1Y '
  277. ELSE IF (MFR.EQ.9.OR.MFR.EQ.5) THEN
  278. * COQUES AVEC CISAILLEMENT TRANSVERSE
  279. NBROBL=8
  280. NBRFAC=0
  281. SEGINI NOMID
  282. MOMATR=NOMID
  283. LESOBL(1)='YG1 '
  284. LESOBL(2)='YG2 '
  285. LESOBL(3)='NU12'
  286. LESOBL(4)='G12 '
  287. LESOBL(5)='G23 '
  288. LESOBL(6)='G13 '
  289. LESOBL(7)='V1X '
  290. LESOBL(8)='V1Y '
  291. ELSE IF (MFR.EQ.75) THEN
  292. *
  293. * JOINT UNIDIMENSIONNEL JOI1
  294. *
  295. IF(IDIM.EQ.3)THEN
  296. NBROBL=12
  297. NBRFAC=0
  298. SEGINI NOMID
  299. MOMATR=NOMID
  300. LESOBL(1)='V1X '
  301. LESOBL(2)='V1Y '
  302. LESOBL(3)='V1Z '
  303. LESOBL(4)='V2X '
  304. LESOBL(5)='V2Y '
  305. LESOBL(6)='V2Z '
  306. LESOBL(7)='KN '
  307. LESOBL(8)='KS1 '
  308. LESOBL(9)='KS2'
  309. LESOBL(10)='QN '
  310. LESOBL(11)='QS1 '
  311. LESOBL(12)='QS2 '
  312. *
  313. ELSE IF(IDIM.EQ.2)THEN
  314. NBROBL=5
  315. NBRFAC=0
  316. SEGINI NOMID
  317. MOMATR=NOMID
  318. LESOBL(1)='V1X '
  319. LESOBL(2)='V1Y '
  320. LESOBL(3)='KN '
  321. LESOBL(4)='KS '
  322. LESOBL(5)='QS'
  323. ENDIF
  324. *
  325. ELSE IF (MFR.EQ.1 .OR. MFR.EQ.31) THEN
  326. * ELEMENTS MASSIFS
  327. IF(IDIM.EQ.3)THEN
  328. * ELEMENTS 3D
  329. NBROBL=15
  330. NBRFAC=0
  331. SEGINI NOMID
  332. MOMATR=NOMID
  333. LESOBL(1)='YG1 '
  334. LESOBL(2)='YG2 '
  335. LESOBL(3)='YG3 '
  336. LESOBL(4)='NU12'
  337. LESOBL(5)='NU23'
  338. LESOBL(6)='NU13'
  339. LESOBL(7)='G12 '
  340. LESOBL(8)='G23 '
  341. LESOBL(9)='G13 '
  342. LESOBL(10)='V1X '
  343. LESOBL(11)='V1Y '
  344. LESOBL(12)='V1Z '
  345. LESOBL(13)='V2X '
  346. LESOBL(14)='V2Y '
  347. LESOBL(15)='V2Z '
  348. ELSE IF (IDIM.EQ.2) THEN
  349. IF(IFOUR.EQ.-2) THEN
  350. * CONT. PLANE
  351. NBROBL=9
  352. NBRFAC=0
  353. SEGINI NOMID
  354. MOMATR=NOMID
  355. LESOBL(1)='YG1 '
  356. LESOBL(2)='YG2 '
  357. LESOBL(3)='NU12 '
  358. LESOBL(4)='G12'
  359. LESOBL(5)='V1X '
  360. LESOBL(6)='V1Y '
  361. LESOBL(7)='YG3 '
  362. LESOBL(8)='NU23'
  363. LESOBL(9)='NU13'
  364. ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) THEN
  365. * DEFORMATION PLANE ,AXISYMETRIE
  366. NBROBL=9
  367. NBRFAC=0
  368. SEGINI NOMID
  369. MOMATR=NOMID
  370. LESOBL(1)='YG1 '
  371. LESOBL(2)='YG2 '
  372. LESOBL(3)='YG3 '
  373. LESOBL(4)='NU12'
  374. LESOBL(5)='NU23'
  375. LESOBL(6)='NU13'
  376. LESOBL(7)='G12 '
  377. LESOBL(8)='V1X '
  378. LESOBL(9)='V1Y '
  379. ELSE IF (IFOUR.EQ.1) THEN
  380. * AXISYMETRIE DE FOURIER
  381. NBROBL=11
  382. NBRFAC=0
  383. SEGINI NOMID
  384. MOMATR=NOMID
  385. LESOBL(1)='YG1 '
  386. LESOBL(2)='YG2 '
  387. LESOBL(3)='YG3 '
  388. LESOBL(4)='NU12'
  389. LESOBL(5)='NU23'
  390. LESOBL(6)='NU13'
  391. LESOBL(7)='G12 '
  392. LESOBL(8)='G23 '
  393. LESOBL(9)='G13 '
  394. LESOBL(10)='V1X '
  395. LESOBL(11)='V1Y '
  396. ENDIF
  397. ENDIF
  398. ELSE IF (MFR.EQ.35) THEN
  399. * ELEMENTS JOINTS
  400. IF (IFOUR.EQ.2) THEN
  401. NBROBL=5
  402. NBRFAC=0
  403. SEGINI NOMID
  404. MOMATR=NOMID
  405. LESOBL(1)='KS1 '
  406. LESOBL(2)='KS2 '
  407. LESOBL(3)='KN '
  408. LESOBL(4)='V1X '
  409. LESOBL(5)='V1Y '
  410. ENDIF
  411. ENDIF
  412. NMATR=NBROBL
  413. NMATF=NBRFAC
  414. ELSEIF (CMATE.EQ.'ANISOTRO') THEN
  415. IF(MFR.EQ.75)THEN
  416. * JOINT UNIDIMESIONNEL JOI1
  417. IF(IDIM.EQ.3)THEN
  418. NBROBL=27
  419. NBRFAC=0
  420. SEGINI NOMID
  421. MOMATR=NOMID
  422. LESOBL(1)='V1X '
  423. LESOBL(2)='V1Y '
  424. LESOBL(3)='V1Z '
  425. LESOBL(4)='V2X '
  426. LESOBL(5)='V2Y '
  427. LESOBL(6)='V2Z '
  428. LESOBL(7)='D11 '
  429. LESOBL(8)='D22 '
  430. LESOBL(9)='D33 '
  431. LESOBL(10)='D44 '
  432. LESOBL(11)='D55 '
  433. LESOBL(12)='D66 '
  434. LESOBL(13)='D21 '
  435. LESOBL(14)='D31 '
  436. LESOBL(15)='D32 '
  437. LESOBL(16)='D41 '
  438. LESOBL(17)='D42 '
  439. LESOBL(18)='D43 '
  440. LESOBL(19)='D51 '
  441. LESOBL(20)='D52 '
  442. LESOBL(21)='D53 '
  443. LESOBL(22)='D54 '
  444. LESOBL(23)='D61 '
  445. LESOBL(24)='D62 '
  446. LESOBL(25)='D63 '
  447. LESOBL(26)='D64 '
  448. LESOBL(27)='D65 '
  449. ELSE IF(IDIM.EQ.2)THEN
  450. NBROBL=8
  451. NBRFAC=0
  452. SEGINI NOMID
  453. MOMATR=NOMID
  454. LESOBL(1)='V1X '
  455. LESOBL(2)='V1Y '
  456. LESOBL(3)='D11 '
  457. LESOBL(4)='D22 '
  458. LESOBL(5)='D33 '
  459. LESOBL(6)='D21 '
  460. LESOBL(7)='D31 '
  461. LESOBL(8)='D32 '
  462. ENDIF
  463. *
  464. ELSE IF (MFR.EQ.1 .OR. MFR.EQ.31) THEN
  465. * ELEMENTS MASSIFS
  466. IF(IDIM.EQ.3)THEN
  467. * ELEMENTS 3D
  468. IF (IFOUR.EQ.2) THEN
  469. NBROBL=27
  470. NBRFAC=0
  471. SEGINI NOMID
  472. MOMATR=NOMID
  473. LESOBL(1)='D11 '
  474. LESOBL(2)='D21 '
  475. LESOBL(3)='D22 '
  476. LESOBL(4)='D31 '
  477. LESOBL(5)='D32 '
  478. LESOBL(6)='D33 '
  479. LESOBL(7)='D41 '
  480. LESOBL(8)='D42 '
  481. LESOBL(9)='D43 '
  482. LESOBL(10)='D44 '
  483. LESOBL(11)='D51 '
  484. LESOBL(12)='D52 '
  485. LESOBL(13)='D53 '
  486. LESOBL(14)='D54 '
  487. LESOBL(15)='D55 '
  488. LESOBL(16)='D61 '
  489. LESOBL(17)='D62 '
  490. LESOBL(18)='D63 '
  491. LESOBL(19)='D64 '
  492. LESOBL(20)='D65 '
  493. LESOBL(21)='D66 '
  494. LESOBL(22)='V1X '
  495. LESOBL(23)='V1Y '
  496. LESOBL(24)='V1Z '
  497. LESOBL(25)='V2X '
  498. LESOBL(26)='V2Y '
  499. LESOBL(27)='V2Z '
  500. ENDIF
  501. ELSE IF (IDIM.EQ.2) THEN
  502. IF (IFOUR.EQ.-2) THEN
  503. * CONTRAINTE PLANE
  504. NBROBL=12
  505. NBRFAC=0
  506. SEGINI NOMID
  507. MOMATR=NOMID
  508. LESOBL(1)='D11 '
  509. LESOBL(2)='D21 '
  510. LESOBL(3)='D22 '
  511. LESOBL(4)='D41 '
  512. LESOBL(5)='D42 '
  513. LESOBL(6)='D44 '
  514. LESOBL(7)='V1X '
  515. LESOBL(8)='V1Y '
  516. LESOBL(9)='D31 '
  517. LESOBL(10)='D32 '
  518. LESOBL(11)='D33 '
  519. LESOBL(12)='D43 '
  520. ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) THEN
  521. * DEFORMATION PLANE ,AXISYMETRIE
  522. NBROBL=12
  523. NBRFAC=0
  524. SEGINI NOMID
  525. MOMATR=NOMID
  526. LESOBL(1)='D11 '
  527. LESOBL(2)='D21 '
  528. LESOBL(3)='D22 '
  529. LESOBL(4)='D31 '
  530. LESOBL(5)='D32 '
  531. LESOBL(6)='D33 '
  532. LESOBL(7)='D41 '
  533. LESOBL(8)='D42 '
  534. LESOBL(9)='D43 '
  535. LESOBL(10)='D44 '
  536. LESOBL(11)='V1X '
  537. LESOBL(12)='V1Y '
  538. ELSE IF (IFOUR.EQ.1) THEN
  539. * AXISYMETRIE DE FOURIER
  540. NBROBL=15
  541. NBRFAC=0
  542. SEGINI NOMID
  543. MOMATR=NOMID
  544. LESOBL(1)='D11 '
  545. LESOBL(2)='D21 '
  546. LESOBL(3)='D22 '
  547. LESOBL(4)='D31 '
  548. LESOBL(5)='D32 '
  549. LESOBL(6)='D33 '
  550. LESOBL(7)='D41 '
  551. LESOBL(8)='D42 '
  552. LESOBL(9)='D43 '
  553. LESOBL(10)='D44 '
  554. LESOBL(11)='D55 '
  555. LESOBL(12)='D65 '
  556. LESOBL(13)='D66 '
  557. LESOBL(14)='V1X '
  558. LESOBL(15)='V1Y '
  559. ENDIF
  560. ENDIF
  561. ENDIF
  562. NMATR=NBROBL
  563. NMATF=NBRFAC
  564. ELSEIF (CMATE.EQ.'UNIDIREC') THEN
  565. IF (IDIM.EQ.3.AND.(MFR.EQ.1.OR.MFR.EQ.33)) THEN
  566. IF (MFR.EQ.1) THEN
  567. NBROBL=7
  568. ELSE
  569. NBROBL=9
  570. ENDIF
  571. NBRFAC=0
  572. SEGINI NOMID
  573. MOMATR=NOMID
  574. LESOBL(1)='YOUN'
  575. LESOBL(2)='V1X '
  576. LESOBL(3)='V1Y '
  577. LESOBL(4)='V1Z '
  578. LESOBL(5)='V2X '
  579. LESOBL(6)='V2Y '
  580. LESOBL(7)='V2Z '
  581. IF (MFR.EQ.33) THEN
  582. LESOBL(8)='COB '
  583. LESOBL(9)='MOB '
  584. ENDIF
  585. ELSE
  586. IF (MFR.EQ.33) THEN
  587. NBROBL=5
  588. ELSE
  589. NBROBL=3
  590. ENDIF
  591. NBRFAC=0
  592. SEGINI NOMID
  593. MOMATR=NOMID
  594. LESOBL(1)='YOUN'
  595. LESOBL(2)='V1X '
  596. LESOBL(3)='V1Y '
  597. IF (MFR.EQ.33) THEN
  598. LESOBL(4)='COB '
  599. LESOBL(5)='MOB '
  600. ENDIF
  601. ENDIF
  602. NMATR=NBROBL
  603. NMATF=NBRFAC
  604. *
  605. ELSEIF (CMATE.EQ.'ZONE_COH') THEN
  606. NBROBL=0
  607. NBRFAC=0
  608. IF (MFR.EQ.77) THEN
  609. NBROBL=2
  610. SEGINI NOMID
  611. MOMATR=NOMID
  612. LESOBL(1)='KS '
  613. LESOBL(2)='KN '
  614. ENDIF
  615. NMATR=NBROBL
  616. NMATF=NBRFAC
  617. *
  618. ELSE
  619. if(lnomid(6).ne.0) then
  620. nomid=lnomid(6)
  621. segact nomid
  622. momatr=nomid
  623. nmatr=lesobl(/2)
  624. nmatf=lesfac(/2)
  625. lsupma=.false.
  626. else
  627. lsupma=.true.
  628. CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  629. endif
  630. ENDIF
  631. ELSE
  632. if(lnomid(6).ne.0) then
  633. nomid=lnomid(6)
  634. segact nomid
  635. momatr=nomid
  636. nmatr=lesobl(/2)
  637. nmatf=lesfac(/2)
  638. lsupma=.false.
  639. else
  640. lsupma=.true.
  641. CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  642. endif
  643. ENDIF
  644. *
  645. IF (CMATE.EQ.'SECTION') THEN
  646. NBTYPE=3
  647. SEGINI NOTYPE
  648. TYPE(1)='POINTEURMMODEL'
  649. TYPE(2)='POINTEURMCHAML'
  650. TYPE(3)='POINTEURLISTREEL'
  651. ELSE
  652. NBTYPE=1
  653. SEGINI NOTYPE
  654. TYPE(1)='REAL*8'
  655. ENDIF
  656. MOTYPE=NOTYPE
  657. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  658. SEGSUP NOTYPE
  659. IF (IERR.NE.0) GOTO 9990
  660. NMATT=NMATR+NMATF
  661. *
  662. IF (MOMATR.NE.0.AND.ISUP.EQ.1) THEN
  663. CALL VALCHE (IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  664. ENDIF
  665. C____________________________________________________________________
  666. C
  667. * TRAITEMENT DES CHAMPS DE CARACTERISTIQUES *
  668. C____________________________________________________________________
  669. C
  670. NBROBL=0
  671. NBRFAC=0
  672. NBTYPE=0
  673. *
  674. * EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES
  675. *
  676. IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  677. NBROBL=1
  678. NBRFAC=1
  679. SEGINI NOMID
  680. MOCARA=NOMID
  681. LESOBL(1)='EPAI'
  682. LESFAC(1)='EXCE'
  683. *
  684. * SECTION POUR LES BARRES
  685. *
  686. ELSE IF (MFR.EQ.27.OR.MFR.EQ.78) THEN
  687. NBROBL=1
  688. SEGINI NOMID
  689. MOCARA=NOMID
  690. LESOBL(1)='SECT'
  691. *
  692. * EPAISSEUR POUR LES JOINTS GENERALISES
  693. *
  694. ELSE IF (MFR.EQ.55) THEN
  695. CcPPj NBROBL=1
  696. CcPPj NBRFAC=0
  697. CcPPj SEGINI NOMID
  698. CcPPj MOCARA=NOMID
  699. CcPPj LESOBL(1)='EPAI'
  700. NBROBL=0
  701. NBRFAC=1
  702. SEGINI NOMID
  703. MOCARA=NOMID
  704. LESFAC(1)='EPAI'
  705. *
  706. * CARACTERISTIQUES POUR LES POUTRES
  707. *
  708. ELSE IF (MFR.EQ.7 ) THEN
  709. IF (CMATE.NE.'SECTION') THEN
  710. IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  711. NBROBL=2
  712. NBRFAC=1
  713. SEGINI NOMID
  714. MOCARA=NOMID
  715. LESOBL(1)='SECT'
  716. LESOBL(2)='INRZ'
  717. LESFAC(1)='SECY'
  718. ELSE
  719. NBROBL=4
  720. NBRFAC=2
  721. SEGINI NOMID
  722. MOCARA=NOMID
  723. LESOBL(1)='TORS'
  724. LESOBL(2)='INRY'
  725. LESOBL(3)='INRZ'
  726. LESOBL(4)='SECT'
  727. LESFAC(1)='SECY'
  728. LESFAC(2)='SECZ'
  729. ENDIF
  730. ENDIF
  731. *
  732. * CARACTERISTIQUES POUR LES TUYAUX
  733. *
  734. ELSE IF (MFR.EQ.13) THEN
  735. NBROBL=2
  736. NBRFAC=3
  737. SEGINI NOMID
  738. MOCARA=NOMID
  739. LESOBL(1)='EPAI'
  740. LESOBL(2)='RAYO'
  741. LESFAC(1)='RACO'
  742. LESFAC(2)='PRES'
  743. LESFAC(3)='CISA'
  744. *
  745. * CARACTERISTIQUES POUR LES LINESPRING
  746. *
  747. ELSE IF (MFR.EQ.15) THEN
  748. NBROBL=5
  749. SEGINI NOMID
  750. MOCARA=NOMID
  751. LESOBL(1)='EPAI'
  752. LESOBL(2)='FISS'
  753. LESOBL(3)='VX '
  754. LESOBL(4)='VY '
  755. LESOBL(5)='VZ '
  756. *
  757. * CARACTERISTIQUES POUR LES TUYAUX FISSURES
  758. *
  759. ELSE IF (MFR.EQ.17) THEN
  760. NBROBL=9
  761. SEGINI NOMID
  762. MOCARA=NOMID
  763. LESOBL(1)='RAYO'
  764. LESOBL(2)='EPAI'
  765. LESOBL(3)='VX '
  766. LESOBL(4)='VY '
  767. LESOBL(5)='VZ '
  768. LESOBL(6)='VXF '
  769. LESOBL(7)='VYF '
  770. LESOBL(8)='VZF '
  771. LESOBL(9)='ANGL'
  772. *
  773. * CARACTERISTIQUES DES ELEMENTS HOMOGENEISES
  774. *
  775. ELSE IF (MFR.EQ.37) THEN
  776. IF(IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN
  777. NBROBL=4
  778. SEGINI NOMID
  779. MOCARA=NOMID
  780. LESOBL(1)='SCEL'
  781. LESOBL(2)='SFLU'
  782. LESOBL(3)='EPS '
  783. LESOBL(4)='XINE'
  784. ELSE
  785. NBROBL=3
  786. SEGINI NOMID
  787. MOCARA=NOMID
  788. LESOBL(1)='SCEL'
  789. LESOBL(2)='SFLU'
  790. LESOBL(3)='EPS '
  791. ENDIF
  792. *
  793. * CARACTERISTIQUE MACRO_EL (element CIFL)
  794. *
  795. ELSE IF (MFR.EQ.61)THEN
  796. NBRFAC=0
  797. NBROBL=2
  798. SEGINI NOMID
  799. MOCARA=NOMID
  800. LESOBL(1)= 'SECT'
  801. LESOBL(2)= 'INRZ'
  802. C
  803. ENDIF
  804. *
  805. IF (IPCHE1.NE.0.AND.MOCARA.NE.0) THEN
  806. NBTYPE=1
  807. SEGINI NOTYPE
  808. MOTYPE=NOTYPE
  809. TYPE(1)='REAL*8'
  810. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,IVACAR)
  811. SEGSUP NOTYPE
  812. IF (IERR.NE.0) GOTO 9990
  813. NOMID=MOCARA
  814. C SEGDES NOMID
  815. ENDIF
  816. NCARA=NBROBL
  817. NCARF=NBRFAC
  818. NCARR=NCARA+NCARF
  819. *
  820. IF (MOCARA.NE.0.AND.ISUP.EQ.1) THEN
  821. CALL VALCHE (IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  822. ENDIF
  823. C segdes mchaml
  824. *
  825. * DANS LE CAS DE L'ELEMENT DST, JOT3 ET JOI4 ORTHO. ON STOCKE EGALEMENT
  826. * V1X ET V1Y
  827. *
  828. IF ((MELE.EQ.93.OR.MELE.EQ.87.OR.MELE.EQ.88).AND.
  829. & CMATE.NE.'ISOTROPE')THEN
  830. MPTVAL=IVAMAT
  831. IF(CMATE.EQ.'ORTHOTRO')THEN
  832. IF (MELE.EQ.87.OR.MELE.EQ.88) THEN
  833. MELVA1=IVAL(4)
  834. ELSE
  835. MELVA1=IVAL(7)
  836. ENDIF
  837. ELSE
  838. MELVA1=IVAL(2)
  839. ENDIF
  840. SEGINI,MELVAL=MELVA1
  841. IELVAL(2)=MELVAL
  842. C SEGDES MELVAL
  843. IF(CMATE.EQ.'ORTHOTRO')THEN
  844. IF (MELE.EQ.87.OR.MELE.EQ.88) THEN
  845. MELVA1=IVAL(5)
  846. ELSE
  847. MELVA1=IVAL(8)
  848. ENDIF
  849. ELSE
  850. MELVA1=IVAL(3)
  851. ENDIF
  852. SEGINI,MELVAL=MELVA1
  853. IELVAL(3)=MELVAL
  854. C SEGDES MELVAL
  855. ENDIF
  856. C____________________________________________________________________
  857. C
  858. * TRAITEMENT DES CHAMPS DE VARIABLES INTERNES *
  859. C____________________________________________________________________
  860. C
  861. lsupva=.true.
  862. IF (IPCHE2.NE.0) THEN
  863. if(lnomid(10).ne.0) then
  864. nomid=lnomid(10)
  865. segact nomid
  866. movari=nomid
  867. nvari=lesobl(/2)
  868. nvarf=lesfac(/2)
  869. lsupva=.false.
  870. else
  871. CALL IDVARI(MFR,IMODEL,MOVARI,NVARI,NVARF)
  872. endif
  873. IF (MOVARI.EQ.0) THEN
  874. MOTERR(1:4)='VARI'
  875. MOTERR(5:8)=NOMTP(MELE)
  876. CALL ERREUR (76)
  877. GOTO 9990
  878. ENDIF
  879. NVART=NVARI+NVARF
  880. *
  881. NBTYPE=1
  882. SEGINI NOTYPE
  883. MOTYPE=NOTYPE
  884. TYPE(1)='REAL*8'
  885. CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOVARI,MOTYPE,1,
  886. 1 INFOS,3,IVARI)
  887. SEGSUP NOTYPE
  888. IF (IERR.NE.0) GOTO 9990
  889. *
  890. IF (ISUP2.EQ.1) THEN
  891. CALL VALCHE(IVARI,NVART,IPMINT,IPPORE,MOVARI,MELE)
  892. ENDIF
  893. ENDIF
  894. C____________________________________________________________________
  895. *
  896. * RECHERCHE DES DIMENSIONS DU MELVAL DE HOOKE
  897. *
  898. C____________________________________________________________________
  899. N2PTEL=0
  900. N2EL=0
  901. MPTVAL=IVAMAT
  902. DO 40 IO=1,NMATT
  903. IF(IVAL(IO).NE.0)THEN
  904. MELVAL=IVAL(IO)
  905. IF (CMATE.EQ.'SECTION') THEN
  906. N2PTEL=MAX(N2PTEL,IELCHE(/1))
  907. N2EL =MAX(N2EL ,IELCHE(/2))
  908. ELSE
  909. N2PTEL=MAX(N2PTEL,VELCHE(/1))
  910. N2EL =MAX(N2EL ,VELCHE(/2))
  911. ENDIF
  912. ENDIF
  913. 40 CONTINUE
  914. MPTVAL=IVACAR
  915. DO 41 IO=1,NCARR
  916. IF(IVAL(IO).NE.0)THEN
  917. MELVAL=IVAL(IO)
  918. IF (CMATE.EQ.'SECTION') THEN
  919. N2PTEL=MAX(N2PTEL,IELCHE(/1))
  920. N2EL =MAX(N2EL ,IELCHE(/2))
  921. ELSE
  922. N2PTEL=MAX(N2PTEL,VELCHE(/1))
  923. N2EL =MAX(N2EL ,VELCHE(/2))
  924. ENDIF
  925. ENDIF
  926. 41 CONTINUE
  927. IF (IPCHE2.NE.0) THEN
  928. MPTVAL=IVARI
  929. DO 42 IO=1,NVART
  930. IF(IVAL(IO).NE.0)THEN
  931. MELVAL=IVAL(IO)
  932. IF (CMATE.EQ.'SECTION') THEN
  933. N2PTEL=MAX(N2PTEL,IELCHE(/1))
  934. N2EL =MAX(N2EL ,IELCHE(/2))
  935. ELSE
  936. N2PTEL=MAX(N2PTEL,VELCHE(/1))
  937. N2EL =MAX(N2EL ,VELCHE(/2))
  938. ENDIF
  939. ENDIF
  940. 42 CONTINUE
  941. ENDIF
  942. C
  943. IF (N2PTEL.EQ.1.OR.NBPGAU.EQ.1) THEN
  944. N2PTEL=1
  945. ELSE
  946. N2PTEL=NBPGAU
  947. ENDIF
  948. *
  949. * INITIALISATION DU MELVAL DE HOOKE
  950. *
  951. N1PTEL=0
  952. N1EL=0
  953. SEGINI MELVAL
  954. IVAHOO=MELVAL
  955. IELVAL(1)=MELVAL
  956.  
  957. C Pour ne pas avoir de LOCK dans ESOPE, on cree tous les MLREEL ici
  958. C Avec un VERROU pour ne pas se marcher dessus dans ESOPE (ooogll)
  959. JG = LHOO2
  960. CALL OOOPRL(1)
  961. DO IB=1,N2EL
  962. DO IGAU=1,N2PTEL
  963. SEGINI,MLREEL
  964. IELCHE(IGAU,IB)=MLREEL
  965. ENDDO
  966. ENDDO
  967. CALL OOOPRL(0)
  968.  
  969. KCAS=1
  970. IF (IPCHE2.EQ.0) INAT=0
  971. CALL HOOK2D(IMODEL,CMATE,INAT,MFR,IVAMAT,NMATT,IVACAR,
  972. 1 NCARR,NPINT,IVARI,NVART,IVAHOO,KCAS,NBPGAU,
  973. 2 LHOOK,LW,LASURF,IPORE,IRTD)
  974. C
  975. IF (IRTD.LE.0 ) GOTO 9990
  976. C
  977. C____________________________________________________________________
  978. C
  979. C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  980. C____________________________________________________________________
  981. C
  982. 510 CONTINUE
  983. C SEGDES,MINTE
  984. C SEGDES IMODEL
  985. MELVAL=IVAHOO
  986. C SEGDES MELVAL
  987. *
  988. IF (ISUP.EQ.1) THEN
  989. CALL DTMVAL(IVAMAT,3)
  990. CALL DTMVAL(IVACAR,3)
  991. ELSE
  992. CALL DTMVAL(IVAMAT,1)
  993. CALL DTMVAL(IVACAR,1)
  994. ENDIF
  995. *
  996. NOMID=MOCARA
  997. IF (MOCARA.NE.0) SEGSUP NOMID
  998. NOMID=MOMATR
  999. if(lsupma)SEGSUP NOMID
  1000. *
  1001. IF(IPCHE2.NE.0) THEN
  1002. IF (ISUP2.EQ.1) THEN
  1003. CALL DTMVAL(IVARI,3)
  1004. ELSE
  1005. CALL DTMVAL(IVARI,1)
  1006. ENDIF
  1007. NOMID=MOVARI
  1008. if(lsupva)SEGSUP NOMID
  1009. ENDIF
  1010. C
  1011. C ERREUR LE MATERIAU PAS ENCORE IMPLEMENTE POUR LA
  1012. C FORMULATION MFR ET L OPTION IFOUR
  1013. C
  1014. IF(IERR.NE.0) THEN
  1015. MOTERR(1:8)=CMATE
  1016. * MOTERR(9:12)=NOMFR(MFR/2+1) MFR PAS DEFINI PV
  1017. INTERR(1)=IFOUR
  1018. CALL ERREUR(81)
  1019. GOTO 888
  1020. ENDIF
  1021. 100 CONTINUE
  1022.  
  1023. IRET = 1
  1024. *
  1025. 888 CONTINUE
  1026. C SEGDES MCHELM
  1027. 666 CONTINUE
  1028. RETURN
  1029. *
  1030. * ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  1031. *
  1032. 9990 CONTINUE
  1033. IRET = 0
  1034.  
  1035. C IF (IPMINT.NE.0) SEGDES,MINTE
  1036. IF (ISUP.EQ.1) THEN
  1037. CALL DTMVAL(IVAMAT,3)
  1038. CALL DTMVAL(IVACAR,3)
  1039. ELSE
  1040. CALL DTMVAL(IVAMAT,1)
  1041. CALL DTMVAL(IVACAR,1)
  1042. ENDIF
  1043. *
  1044. NOMID=MOCARA
  1045. IF (MOCARA.NE.0) SEGSUP NOMID
  1046. NOMID=MOMATR
  1047. IF (MOMATR.NE.0.and.lsupma) SEGSUP NOMID
  1048. *
  1049. IF (IPCHE2.NE.0.AND.IVARI.NE.0) THEN
  1050. IF (ISUP2.EQ.1) THEN
  1051. CALL DTMVAL(IVARI,3)
  1052. ELSE
  1053. CALL DTMVAL(IVARI,1)
  1054. ENDIF
  1055. NOMID=MOVARI
  1056. if(lsupva)SEGSUP NOMID
  1057. ENDIF
  1058. *
  1059. IF(IVAHOO.NE.0) THEN
  1060. MELVAL=IVAHOO
  1061. SEGSUP MELVAL
  1062. ENDIF
  1063. C SEGDES IMODEL
  1064. SEGSUP MCHAML
  1065. *
  1066. C SEGDES MMODEL
  1067. IF (IPCHE1.NE.0) THEN
  1068. MCHEL1=IPCHE1
  1069. C SEGDES MCHEL1
  1070. ENDIF
  1071. SEGSUP MCHELM
  1072.  
  1073. RETURN
  1074. END
  1075.  
  1076.  
  1077.  
  1078.  
  1079.  
  1080.  
  1081.  
  1082.  
  1083.  
  1084.  
  1085.  
  1086.  
  1087.  
  1088.  
  1089.  

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