Télécharger hook2p.eso

Retour à la liste

Numérotation des lignes :

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

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