Télécharger ecoul1.eso

Retour à la liste

Numérotation des lignes :

ecoul1
  1. C ECOUL1 SOURCE PV 21/12/18 07:15:02 11240
  2. SUBROUTINE ECOUL1(IPMODL,IPCHE1,IPCHE2,IPCHE3,IPCHE4,IPCHE6,
  3. & IPCAR,IPCH1,IPCH2,IPCH3,IPCH4,IPCH5,ITHHER,IFI,PRECIS,
  4. & IPOTAB,JECHER,ISTEP,JNOID,LOGSUC,IPCHE7,IPCHE8,IPCHE9)
  5. **********************************************************************
  6. *
  7. * ecoulement inelastique
  8. *
  9. **********************************************************************
  10. *
  11. * entrees:
  12. *
  13. * ipmodl = pointeur sur un objet mmodel
  14. * ipche1 = pointeur sur un mchaml de contraintes initiales
  15. * ipche2 = pointeur sur un mchaml de variables internes initiales
  16. * ipche3 = pointeur sur un mchaml de deformations inelastiques initiale
  17. * ipche4 = pointeur sur un mchaml d'increment elastique de deformations
  18. * ipche5 = pointeur sur un mchaml de deformations
  19. * ipcar = pointeur sur un mchaml de caracteristiques
  20. * ipch1 = pointeur sur un mchaml de temperatures au debut du pas
  21. * ipch2 = pointeur sur un mchaml de temperatures a la fin du pas
  22. * ipch3 = pointeur sur un mchaml de temperatures de reference
  23. c mistral :
  24. * ipch4 = pointeur sur un mchaml de flux neutronique au debut du pas pou
  25. * ipch5 = pointeur sur un mchaml de flux neutronique a la fin du pas pou
  26. * ifi = 0 pas de flux neutronique; = 1 existence de flux neutronique (
  27. c mistral.
  28. * ithher = 0 si pas de chargement thermique
  29. * = 1 si chargement thermique mais materiau constant
  30. * = 2 si chargement thermique et mat. dependant de la temperature
  31. * ipch1,ipch2,ipch3,ithher ne servent que pour les materiaux
  32. * endommageables de lemaitre quand ils dependent de la temperature
  33. * precis = precision des iterations internes
  34. * ipotab = pointeur sur une table
  35. * jecher = flag valant 0 ou 1(pour action dans ecoule)
  36. * istep =indicateur d'action pour calcul nonlocal
  37. * =0 dans le cas d'un calcul local (normal)
  38. * =1 ou 2 dans le cas d'un calcul nonlocal
  39. * =1 pour calcul des fonctions seuil uniquement
  40. * =2 pour calcul des variables dissipatives a partir
  41. * des fonctions seuil moyennees prealablement par nloc
  42. * jnoid = flag valant 0 ou 1(pour action dans ecoul1)
  43. *
  44. * sorties:
  45. *
  46. * logsuc = logique pour indication de pb de convergence
  47. * ipche7 = pointeur sur un mchaml de contraintes
  48. * ipche8 = pointeur sur un mchaml de variables internes
  49. * ipche9 = pointeur sur un mchaml de deformations
  50. *
  51. ************************************************************************
  52. IMPLICIT INTEGER(I-N)
  53. IMPLICIT REAL*8(A-H,O-Z)
  54. *
  55.  
  56. -INC PPARAM
  57. -INC CCOPTIO
  58. -INC CCGEOME
  59. -INC SMCHAML
  60. c mistral :
  61. POINTEUR MCHEL7.MCHELM,MCHEL8.MCHELM
  62. c mistral.
  63. -INC SMELEME
  64. -INC SMCOORD
  65. -INC SMMODEL
  66. -INC SMINTE
  67. -INC CCHAMP
  68. Pointeur nomid1.nomid
  69. c
  70. SEGMENT NOTYPE
  71. CHARACTER*16 TYPE(NBTYPE)
  72. ENDSEGMENT
  73. *
  74. SEGMENT MPTVAL
  75. INTEGER IPOS(NS) ,NSOF(NS)
  76. INTEGER IVAL(NCOSOU)
  77. CHARACTER*16 TYVAL(NCOSOU)
  78. ENDSEGMENT
  79. *
  80. CHARACTER*8 CMATE
  81. CHARACTER*(NCONCH) CONM
  82. LOGICAL LOGSUC,lsupva,lsupco,lsupde,lsupma,lsupdd
  83. PARAMETER ( NINF=3 )
  84. INTEGER INFOS(NINF)
  85. lsupva=.false.
  86. lsupde=.false.
  87. lsupdd=.false.
  88. c
  89. NHRM=NIFOUR
  90. c
  91. c verification du lieu support du mchaml de contraintes
  92. c
  93. CALL QUESUP(IPMODL,IPCHE1,5,0,ISUP1,IRET1)
  94. IF (ISUP1.GT.1) RETURN
  95. *
  96. * verification du lieu support du mchaml de variables internes
  97. *
  98. CALL QUESUP(IPMODL,IPCHE2,5,0,ISUP2,IRET2)
  99. IF (ISUP2.GT.1) RETURN
  100. c
  101. c verification du lieu support du mchaml de defor. inelastique init.
  102. c
  103. IF(IPCHE3.NE.0)THEN
  104. CALL QUESUP(IPMODL,IPCHE3,5,0,ISUP3,IRET3)
  105. IF (ISUP3.GT.1) RETURN
  106. ELSE
  107. ISUP3=0
  108. ENDIF
  109. c
  110. c verification du lieu support du mchaml de defor. totales
  111. c
  112. IF(IPCHE6.NE.0)THEN
  113. CALL QUESUP(IPMODL,IPCHE6,5,0,ISUP6,IRET6)
  114. IF (ISUP6.GT.1) RETURN
  115. ELSE
  116. ISUP6=0
  117. ENDIF
  118. c
  119. c verification du lieu support du mchaml des incr. deformat totales
  120. c
  121. CALL QUESUP(IPMODL,IPCHE4,5,0,ISUP4,IRET4)
  122. IF (ISUP4.GT.1) RETURN
  123. c
  124. c verification du lieu support du mchaml de caracteristiques
  125. c
  126. CALL QUESUP(IPMODL,IPCAR,3,0,ISUP5,IRET5)
  127. IF (ISUP5.GT.1) RETURN
  128.  
  129. c
  130. c activation du modele
  131. c
  132. MMODEL=IPMODL
  133. SEGACT MMODEL
  134. NSOUS=KMODEL(/1)
  135. c
  136. c creation des 3 mchelms
  137. c
  138. N1=NSOUS
  139. L1=11
  140. N3=6
  141. SEGINI MCHELM
  142. TITCHE='CONTRAINTES'
  143. IFOCHE=IFOUR
  144. IPCHE7=MCHELM
  145. L1=18
  146. SEGINI MCHEL1
  147. MCHEL1.TITCHE='VARIABLES INTERNES'
  148. MCHEL1.IFOCHE=IFOUR
  149. IPCHE8=MCHEL1
  150. L1=12
  151. SEGINI MCHEL2
  152. MCHEL2.TITCHE='DEFORMATIONS INELASTIQUES'
  153. MCHEL2.IFOCHE=IFOUR
  154. IPCHE9=MCHEL2
  155. c
  156. c traitement des champs de temperature pour les materiaux
  157. c endommageables de lemaitre
  158. c
  159. IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  160. MCHEL3=IPCH1
  161. MCHEL4=IPCH2
  162. MCHEL5=IPCH3
  163. SEGACT MCHEL3
  164. SEGACT MCHEL4
  165. SEGACT MCHEL5
  166. ENDIF
  167. ***********************
  168. * SPECIAL SUCCION
  169. *
  170. IF (ITHHER.EQ.3) THEN
  171. MCHEL3=IPCH1
  172. MCHEL4=IPCH2
  173. SEGACT MCHEL3
  174. SEGACT MCHEL4
  175. ENDIF
  176. ***********************
  177. c mistral :
  178. IF (IFI.EQ.1) THEN
  179. MCHEL7=IPCH4
  180. MCHEL8=IPCH5
  181. SEGACT MCHEL7
  182. SEGACT MCHEL8
  183. ENDIF
  184. c mistral.
  185. *
  186. * deformations totales
  187. *
  188. IF(IPCHE6.NE.0) THEN
  189. MCHEL6=IPCHE6
  190. SEGACT MCHEL6
  191. ENDIF
  192. c____________________________________________________________________
  193. c
  194. c debut de la boucle sur les differentes zones
  195. c____________________________________________________________________
  196. c
  197. DO 1000 ISOUS=1,NSOUS
  198. *
  199. * initialisation
  200. *
  201. NSTR=0
  202. MOSTRS=0
  203. IVASTR=0
  204. MOVARI=0
  205. NVARI=0
  206. NVARF=0
  207. IVARI=0
  208. MOEPSI=0
  209. MODEIN=0
  210. NDEF=0
  211. NDEIN=0
  212. IVADEF=0
  213. IVADET=0
  214. IVADS=0
  215. NCARA=0
  216. NCARF=0
  217. MOCARA=0
  218. IVACAR=0
  219. NMATF=0
  220. NMATR=0
  221. MOMATR=0
  222. IVAMAT=0
  223. IVASTF=0
  224. IVARIF=0
  225. IVADEP=0
  226. KERRE=0
  227. KERR1=0
  228. MCHAML=0
  229. MCHAM1=0
  230. MCHAM2=0
  231. lsupma=.true.
  232. c
  233. c on recupere l information generale
  234. c
  235. IMODEL=KMODEL(ISOUS)
  236. SEGACT IMODEL
  237. IPMAIL=IMAMOD
  238. CONM =CONMOD
  239. IMACHE(ISOUS)=IPMAIL
  240. CONCHE(ISOUS)=CONMOD
  241. MCHEL1.IMACHE(ISOUS)=IPMAIL
  242. MCHEL1.CONCHE(ISOUS)=CONMOD
  243. MCHEL2.IMACHE(ISOUS)=IPMAIL
  244. MCHEL2.CONCHE(ISOUS)=CONMOD
  245. *
  246. MELE=NEFMOD
  247. MELEME=IMAMOD
  248. SEGACT MELEME
  249. NBNN=NUM(/1)
  250. NBELEM=NUM(/2)
  251. c
  252. c coque integree ou pas ?
  253. c
  254. IF(INFMOD(/1).NE.0)THEN
  255. NPINT=INFMOD(1)
  256. ELSE
  257. NPINT=0
  258. ENDIF
  259. c
  260. c traitement du modele
  261. c
  262. NFOR=FORMOD(/2)
  263. NMAT=MATMOD(/2)
  264. c
  265. c nature du materiau
  266. c
  267. C CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INPLAS)
  268. CMATE = CMATEE
  269. MATE = IMATEE
  270. INPLAS = INATUU
  271. IF (CMATE.EQ.' ')THEN
  272. CALL ERREUR(251)
  273. SEGDES IMODEL*NOMOD,MMODEL*NOMOD
  274. SEGSUP MCHELM ,MCHEL1,MCHEL2
  275. RETURN
  276. ENDIF
  277. *
  278. c____________________________________________________________________
  279. c
  280. c information sur l'element fini
  281. c____________________________________________________________________
  282. c
  283. * CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  284. IF (IERR.NE.0) THEN
  285. SEGDES IMODEL*NOMOD,MMODEL*NOMOD
  286. SEGSUP MCHELM,MCHEL1,MCHEL2
  287. RETURN
  288. ENDIF
  289. * INFO=IPINF
  290. MFR =INFELE(13)
  291. NBG =INFELE(6)
  292. NBGS =INFELE(4)
  293. NSTRS=INFELE(16)
  294. LRE =INFELE(9)
  295. IPPORE=0
  296. IF(MFR.EQ.33) IPPORE=NBNN
  297. LW =200
  298. LW2 =150
  299. LHOOK=INFELE(10)
  300. *
  301. IF (MFR.EQ.3.AND.NPINT.NE.0) LHOOK=4
  302. *
  303. LHOO2=LHOOK*LHOOK
  304. * MINTE=INFELE(11)
  305. minte=infmod(7)
  306. IPMINT=MINTE
  307.  
  308. IPORE=INFELE(8)
  309. NBNO=NBNNE(NUMGEO(MELE))
  310. IF (MELE.EQ.96) NBNO = INFELE(8)
  311. IF (MFR.EQ.33) NBNO=IPORE
  312. *
  313. * remplissage des tableaux infche
  314. *
  315. INFCHE(ISOUS,1)=0
  316. INFCHE(ISOUS,2)=0
  317. INFCHE(ISOUS,3)=NHRM
  318. INFCHE(ISOUS,4)=MINTE
  319. INFCHE(ISOUS,5)=0
  320. INFCHE(ISOUS,6)=5
  321. *
  322. MCHEL1.INFCHE(ISOUS,1)=0
  323. MCHEL1.INFCHE(ISOUS,2)=0
  324. MCHEL1.INFCHE(ISOUS,3)=NHRM
  325. MCHEL1.INFCHE(ISOUS,4)=MINTE
  326. MCHEL1.INFCHE(ISOUS,5)=0
  327. MCHEL1.INFCHE(ISOUS,6)=5
  328. *
  329. MCHEL2.INFCHE(ISOUS,1)=0
  330. MCHEL2.INFCHE(ISOUS,2)=0
  331. MCHEL2.INFCHE(ISOUS,3)=NHRM
  332. MCHEL2.INFCHE(ISOUS,4)=MINTE
  333. MCHEL2.INFCHE(ISOUS,5)=0
  334. MCHEL2.INFCHE(ISOUS,6)=5
  335. c
  336. c creation du tableau infos
  337. c
  338. CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  339. IF (IRTD.EQ.0)THEN
  340. SEGDES IMODEL*NOMOD,MMODEL*NOMOD
  341. SEGSUP MCHELM,MCHEL1,MCHEL2
  342. * INFO=IPINF
  343. * SEGSUP INFO
  344. RETURN
  345. ENDIF
  346. *
  347. * traitement du champ de contraintes
  348. *
  349. if(lnomid(4).ne.0) then
  350. nomid=lnomid(4)
  351. segact nomid
  352. mostrs=nomid
  353. nstr=lesobl(/2)
  354. nfac=lesfac(/2)
  355. lsupco=.false.
  356. else
  357. lsupco=.true.
  358. CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC)
  359. endif
  360. IF (MOSTRS.EQ.0) THEN
  361. MOTERR(1:4)='CONT'
  362. MOTERR(5:8)=NOMTP(MELE)
  363. CALL ERREUR (76)
  364. SEGDES IMODEL*NOMOD,MMODEL*NOMOD
  365. SEGSUP MCHELM,MCHEL1,MCHEL2
  366. * INFO=IPINF
  367. * SEGSUP INFO
  368. RETURN
  369. ENDIF
  370. *
  371. NBTYPE=1
  372. SEGINI NOTYPE
  373. MOTYPE=NOTYPE
  374. TYPE(1)='REAL*8'
  375. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOSTRS,MOTYPE,1,INFOS,3,IVASTR)
  376. IF(IERR.NE.0)THEN
  377. SEGSUP NOTYPE
  378. KERRE=999
  379. GOTO 9990
  380. ENDIF
  381. *
  382. IF (ISUP1.EQ.1) THEN
  383. CALL VALCHE(IVASTR,NSTR,IPMINT,IPPORE,MOSTRS,MELE)
  384. IF(IERR.NE.0)THEN
  385. SEGSUP NOTYPE
  386. KERRE=999
  387. ISUP1=0
  388. GOTO 9990
  389. ENDIF
  390. ENDIF
  391. *
  392. * traitement du champ de variables internes
  393. *
  394. MOTYVA=NOTYPE
  395. *
  396. * cas particulier poutre a fibres
  397. *
  398. IF(MFR.EQ.7.AND.CMATE.EQ.'SECTION') THEN
  399. NBTYPE=1
  400. SEGINI NOTYPE
  401. MOTYVA=NOTYPE
  402. TYPE(1)='POINTEURMCHAML '
  403. *
  404. * cas particulier modele de maxwell
  405. *
  406. ELSE IF(INPLAS.EQ.74) THEN
  407. NBTYPE=10
  408. SEGINI NOTYPE
  409. MOTYVA=NOTYPE
  410. TYPE(1)='REAL*8'
  411. DO IC=2,10
  412. TYPE(IC)='POINTEURLISTREEL'
  413. END DO
  414. ENDIF
  415. if(lnomid(10).ne.0) then
  416. nomid=lnomid(10)
  417. segact nomid
  418. movari=nomid
  419. nvari=lesobl(/2)
  420. nvarf=lesfac(/2)
  421. lsupva=.false.
  422. else
  423. lsupva=.true.
  424. CALL IDVARI(MFR,IMODEL,MOVARI,NVARI,NVARF)
  425. endif
  426. IF (MOVARI.EQ.0) THEN
  427. MOTERR(1:4)='VARI'
  428. MOTERR(5:8)=NOMTP(MELE)
  429. CALL ERREUR (76)
  430. KERRE=999
  431. SEGSUP NOTYPE
  432. GOTO 9990
  433. ENDIF
  434. *
  435. CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOVARI,MOTYVA,1,INFOS,3,IVARI)
  436. IF(IERR.NE.0)THEN
  437. NOTYPE=MOTYVA
  438. SEGSUP NOTYPE
  439. KERRE=999
  440. GOTO 9990
  441. ENDIF
  442. *
  443. NVART=NVARI+NVARF
  444. *
  445. IF (ISUP2.EQ.1) THEN
  446. CALL VALCHE(IVARI,NVART,IPMINT,IPPORE,MOVARI,MELE)
  447. IF(IERR.NE.0)THEN
  448. SEGSUP NOTYPE
  449. KERRE=999
  450. ISUP2=0
  451. GOTO 9990
  452. ENDIF
  453. ENDIF
  454. *
  455. * traitement du champ de deformations inelastiques
  456. *
  457. if(lnomid(5).ne.0)then
  458. nomid1=lnomid(5)
  459. segini,nomid=nomid1
  460. ndef=lesobl(/2)
  461. nfac=lesfac(/2)
  462. moepsi=nomid
  463. lsupde=.false.
  464. else
  465. lsupde=.true.
  466. CALL IDDEFO(IMODEL,IFOUR,MOEPSI,NDEF,NFAC)
  467. endif
  468. if(lnomid(13).ne.0) then
  469. nomid=lnomid(13)
  470. segact nomid
  471. modein=nomid
  472. ndein=lesobl(/2)
  473. nfac=lesfac(/2)
  474. lsupdd=.false.
  475. else
  476. lsupdd=.true.
  477. CALL IDDEIN(IMODEL,IFOUR,MODEIN,NDEIN,NFAC)
  478. endif
  479. if (NDEF.NE.NDEIN) then
  480. c.. en principe meme nombre de composantes pour deformations et def inelas
  481. call erreur(5)
  482. return
  483. endif
  484. IF (MODEIN.EQ.0) THEN
  485. MOTERR(1:4)='DEIN'
  486. MOTERR(5:8)=NOMTP(MELE)
  487. CALL ERREUR (76)
  488. KERRE=999
  489. SEGSUP NOTYPE
  490. GOTO 9990
  491. ENDIF
  492. *
  493. IF(IPCHE3.NE.0)THEN
  494. CALL KOMCHA(IPCHE3,IPMAIL,CONM,MODEIN,MOTYPE
  495. & ,1,INFOS,3,IVADEF)
  496. IF(IERR.NE.0)THEN
  497. SEGSUP NOTYPE
  498. KERRE=999
  499. GOTO 9990
  500. ENDIF
  501. *
  502. IF (ISUP3.EQ.1) THEN
  503. CALL VALCHE(IVADEF,NDEF,IPMINT,IPPORE,MODEIN,MELE)
  504. IF(IERR.NE.0)THEN
  505. SEGSUP NOTYPE
  506. KERRE=999
  507. ISUP3=0
  508. GOTO 9990
  509. ENDIF
  510. ENDIF
  511. ENDIF
  512. *
  513. * traitement du champ de deformations totales
  514. *
  515. IF(IPCHE6.NE.0)THEN
  516. CALL KOMCHA(IPCHE6,IPMAIL,CONM,MOEPSI,MOTYPE
  517. & ,1,INFOS,3,IVADET)
  518. IF(IERR.NE.0)THEN
  519. SEGSUP NOTYPE
  520. KERRE=999
  521. GOTO 9990
  522. ENDIF
  523. *
  524. IF (ISUP6.EQ.1) THEN
  525. CALL VALCHE(IVADET,NDEF,IPMINT,IPPORE,MOEPSI,MELE)
  526. IF(IERR.NE.0)THEN
  527. SEGSUP NOTYPE
  528. KERRE=999
  529. ISUP6=0
  530. GOTO 9990
  531. ENDIF
  532. ENDIF
  533. ENDIF
  534. *
  535. * traitement du champ d'increments de deformations
  536. *
  537. CALL KOMCHA(IPCHE4,IPMAIL,CONM,MOEPSI,
  538. 1 MOTYPE,1,INFOS,3,IVADS)
  539. *********SEGSUP NOTYPE
  540. IF(IERR.NE.0)THEN
  541. SEGSUP NOTYPE
  542. KERRE=999
  543. GOTO 9990
  544. ENDIF
  545. *
  546. IF (ISUP4.EQ.1) THEN
  547. CALL VALCHE(IVADS,NDEF,IPMINT,IPPORE,MOEPSI,MELE)
  548. IF(IERR.NE.0)THEN
  549. SEGSUP NOTYPE
  550. KERRE=999
  551. ISUP4=0
  552. GOTO 9990
  553. ENDIF
  554. ENDIF
  555. *
  556. * traitement du champ de caracteristiques materielles
  557. *
  558. if(lnomid(6).ne.0) then
  559. nomid=lnomid(6)
  560. segact nomid
  561. momatr=nomid
  562. nmatr=lesobl(/2)
  563. nmatf=lesfac(/2)
  564. lsupma=.false.
  565. else
  566. lsupma=.true.
  567. CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  568. endif
  569. IF (MOMATR.EQ.0) THEN
  570. MOTERR(1:4)='MATE'
  571. MOTERR(5:8)=NOMTP(MELE)
  572. CALL ERREUR (76)
  573. KERRE=999
  574. GOTO 9990
  575. ENDIF
  576.  
  577. *
  578. IF(MATE.EQ.1.AND.(INPLAS.EQ.5.OR.INPLAS.EQ.87))THEN
  579. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  580. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  581. NBTYPE=6
  582. ELSE
  583. NBTYPE=5
  584. ENDIF
  585. SEGINI NOTYPE
  586. MOTYPE=NOTYPE
  587. TYPE(1)='REAL*8'
  588. TYPE(2)='REAL*8'
  589. TYPE(3)='POINTEUREVOLUTIO'
  590. TYPE(4)='REAL*8'
  591. TYPE(5)='REAL*8'
  592. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  593. + AND.IFOUR.EQ.-2) TYPE(6)='REAL*8'
  594. C
  595. ELSE IF(MATE.EQ.4.AND.INPLAS.EQ.5)THEN
  596. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  597. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  598. NBTYPE=7
  599. ELSE
  600. NBTYPE=6
  601. ENDIF
  602. SEGINI NOTYPE
  603. MOTYPE=NOTYPE
  604. TYPE(1)='REAL*8'
  605. TYPE(2)='REAL*8'
  606. TYPE(3)='REAL*8'
  607. TYPE(4)='POINTEUREVOLUTIO'
  608. TYPE(5)='REAL*8'
  609. TYPE(6)='REAL*8'
  610. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  611. + AND.IFOUR.EQ.-2) TYPE(7)='REAL*8'
  612. C
  613. ELSE IF(MATE.EQ.1.AND.INPLAS.EQ.51)THEN
  614. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  615. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  616. NBTYPE=8
  617. ELSE
  618. NBTYPE=7
  619. ENDIF
  620. SEGINI NOTYPE
  621. MOTYPE=NOTYPE
  622. TYPE(1)='REAL*8'
  623. TYPE(2)='REAL*8'
  624. TYPE(3)='POINTEUREVOLUTIO'
  625. TYPE(4)='POINTEUREVOLUTIO'
  626. TYPE(5)='POINTEUREVOLUTIO'
  627. TYPE(6)='REAL*8'
  628. TYPE(7)='REAL*8'
  629. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  630. + AND.IFOUR.EQ.-2) TYPE(8)='REAL*8'
  631. C
  632. ELSE IF(MATE.EQ.4.AND.INPLAS.EQ.51)THEN
  633. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  634. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  635. NBTYPE=9
  636. ELSE
  637. NBTYPE=8
  638. ENDIF
  639. SEGINI NOTYPE
  640. MOTYPE=NOTYPE
  641. TYPE(1)='REAL*8'
  642. TYPE(2)='REAL*8'
  643. TYPE(3)='REAL*8'
  644. TYPE(4)='POINTEUREVOLUTIO'
  645. TYPE(5)='POINTEUREVOLUTIO'
  646. TYPE(6)='POINTEUREVOLUTIO'
  647. TYPE(7)='REAL*8'
  648. TYPE(8)='REAL*8'
  649. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  650. + AND.IFOUR.EQ.-2) TYPE(9)='REAL*8'
  651. C
  652. ELSE IF(MATE.EQ.1.AND.INPLAS.EQ.62)THEN
  653. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  654. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  655. NBTYPE=6
  656. ELSE
  657. NBTYPE=5
  658. ENDIF
  659. SEGINI NOTYPE
  660. MOTYPE=NOTYPE
  661. TYPE(1)='REAL*8'
  662. TYPE(2)='REAL*8'
  663. TYPE(3)='POINTEUREVOLUTIO'
  664. TYPE(4)='REAL*8'
  665. TYPE(5)='REAL*8'
  666. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  667. + AND.IFOUR.EQ.-2) TYPE(6)='REAL*8'
  668. C
  669. ELSE IF(MATE.EQ.1.AND.INPLAS.EQ.64)THEN
  670. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  671. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  672. NBTYPE=15
  673. ELSE
  674. NBTYPE=14
  675. ENDIF
  676. SEGINI NOTYPE
  677. MOTYPE=NOTYPE
  678. TYPE(1)='REAL*8'
  679. TYPE(2)='REAL*8'
  680. TYPE(3)='POINTEUREVOLUTIO'
  681. TYPE(4)='REAL*8'
  682. TYPE(5)='REAL*8'
  683. TYPE(6)='REAL*8'
  684. TYPE(7)='REAL*8'
  685. TYPE(8)='REAL*8'
  686. TYPE(9)='REAL*8'
  687. TYPE(10)='REAL*8'
  688. TYPE(11)='REAL*8'
  689. TYPE(12)='REAL*8'
  690. TYPE(13)='REAL*8'
  691. TYPE(14)='REAL*8'
  692. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  693. + AND.IFOUR.EQ.-2) TYPE(15)='REAL*8'
  694. C
  695. ELSE IF (MATE.EQ.1.AND.INPLAS.EQ.14) THEN
  696. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  697. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  698. NBTYPE=10
  699. ELSE
  700. NBTYPE=9
  701. ENDIF
  702. NBTYPE=9
  703. SEGINI NOTYPE
  704. MOTYPE=NOTYPE
  705. TYPE(1)='REAL*8'
  706. TYPE(2)='REAL*8'
  707. TYPE(3)='REAL*8'
  708. TYPE(4)='REAL*8'
  709. TYPE(5)='REAL*8'
  710. TYPE(6)='POINTEUREVOLUTIO'
  711. TYPE(7)='POINTEUREVOLUTIO'
  712. TYPE(8)='REAL*8'
  713. TYPE(9)='REAL*8'
  714. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  715. + AND.IFOUR.EQ.-2) TYPE(10)='REAL*8'
  716. C
  717. ELSE IF (MATE.EQ.1.AND.INPLAS.EQ.26) THEN
  718. IF (ITHHER.EQ.2) THEN
  719. NBTYPE=0
  720. SEGINI NOTYPE
  721. MOTYPE=NOTYPE
  722. ELSE
  723. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  724. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  725. NBTYPE=9
  726. ELSE
  727. NBTYPE=8
  728. ENDIF
  729. SEGINI NOTYPE
  730. MOTYPE=NOTYPE
  731. TYPE(1)='REAL*8'
  732. TYPE(2)='REAL*8'
  733. TYPE(3)='POINTEUREVOLUTIO'
  734. TYPE(4)='REAL*8'
  735. TYPE(5)='REAL*8'
  736. TYPE(6)='REAL*8'
  737. TYPE(7)='REAL*8'
  738. TYPE(8)='REAL*8'
  739. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  740. + AND.IFOUR.EQ.-2) TYPE(9)='REAL*8'
  741. ENDIF
  742. C
  743. ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.29)THEN
  744. IF (ITHHER.EQ.2) THEN
  745. NBTYPE=0
  746. SEGINI NOTYPE
  747. MOTYPE=NOTYPE
  748. ELSE
  749. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  750. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  751. NBTYPE=14
  752. ELSE
  753. NBTYPE=13
  754. ENDIF
  755. SEGINI NOTYPE
  756. MOTYPE=NOTYPE
  757. TYPE(1)='REAL*8'
  758. TYPE(2)='REAL*8'
  759. TYPE(3)='REAL*8'
  760. TYPE(4)='REAL*8'
  761. TYPE(5)='REAL*8'
  762. TYPE(6)='REAL*8'
  763. TYPE(7)='REAL*8'
  764. TYPE(8)='REAL*8'
  765. TYPE(9)='REAL*8'
  766. TYPE(10)='POINTEUREVOLUTIO'
  767. TYPE(11)='REAL*8'
  768. TYPE(12)='REAL*8'
  769. TYPE(13)='REAL*8'
  770. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  771. + AND.IFOUR.EQ.-2) TYPE(14)='REAL*8'
  772. ENDIF
  773. C
  774. ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.16)THEN
  775. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  776. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  777. NBTYPE=8
  778. ELSE
  779. NBTYPE=7
  780. ENDIF
  781. SEGINI NOTYPE
  782. MOTYPE=NOTYPE
  783. TYPE(1)='REAL*8'
  784. TYPE(2)='REAL*8'
  785. TYPE(3)='POINTEUREVOLUTIO'
  786. TYPE(4)='REAL*8'
  787. TYPE(5)='REAL*8'
  788. TYPE(6)='REAL*8'
  789. TYPE(7)='REAL*8'
  790. C
  791. ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.2)THEN
  792. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  793. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  794. NBTYPE=7
  795. ELSE
  796. NBTYPE=6
  797. ENDIF
  798. SEGINI NOTYPE
  799. MOTYPE=NOTYPE
  800. TYPE(1)='REAL*8'
  801. TYPE(2)='REAL*8'
  802. TYPE(3)='REAL*8'
  803. TYPE(4)='POINTEUREVOLUTIO'
  804. TYPE(5)='REAL*8'
  805. TYPE(6)='REAL*8'
  806. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  807. + AND.IFOUR.EQ.-2) TYPE(7)='REAL*8'
  808. C
  809. ELSE IF(MATE.EQ.1.AND.INPLAS.EQ.32)THEN
  810. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  811. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  812. NBTYPE=10
  813. ELSE
  814. NBTYPE=19
  815. ENDIF
  816. SEGINI NOTYPE
  817. MOTYPE=NOTYPE
  818. TYPE(1)='REAL*8'
  819. TYPE(2)='REAL*8'
  820. TYPE(3)='REAL*8'
  821. TYPE(4)='REAL*8'
  822. TYPE(5)='POINTEUREVOLUTIO'
  823. TYPE(6)='POINTEUREVOLUTIO'
  824. TYPE(7)='POINTEUREVOLUTIO'
  825. TYPE(8)='POINTEUREVOLUTIO'
  826. TYPE(9)='POINTEUREVOLUTIO'
  827. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  828. + AND.IFOUR.EQ.-2) TYPE(10)='REAL*8'
  829. C
  830. ELSE IF(MATE.EQ.1.AND.INPLAS.EQ.44)THEN
  831. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  832. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  833. NBTYPE=21
  834. ELSE
  835. NBTYPE=20
  836. ENDIF
  837. SEGINI NOTYPE
  838. MOTYPE=NOTYPE
  839. TYPE(1)='REAL*8'
  840. TYPE(2)='REAL*8'
  841. TYPE(3)='REAL*8'
  842. TYPE(4)='REAL*8'
  843. TYPE(5)='REAL*8'
  844. TYPE(6)='REAL*8'
  845. TYPE(7)='REAL*8'
  846. TYPE(8)='REAL*8'
  847. TYPE(9)='REAL*8'
  848. TYPE(10)='REAL*8'
  849. TYPE(11)='REAL*8'
  850. TYPE(12)='REAL*8'
  851. TYPE(13)='REAL*8'
  852. TYPE(14)='REAL*8'
  853. TYPE(15)='REAL*8'
  854. TYPE(16)='REAL*8'
  855. TYPE(17)='REAL*8'
  856. TYPE(18)='REAL*8'
  857. TYPE(19)='REAL*8'
  858. TYPE(20)='REAL*8'
  859. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  860. + AND.IFOUR.EQ.-2) TYPE(21)='REAL*8'
  861. C
  862. ELSE IF(MATE.EQ.1.AND.INPLAS.EQ.45)THEN
  863. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  864. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  865. NBTYPE=28
  866. ELSE
  867. NBTYPE=27
  868. ENDIF
  869. SEGINI NOTYPE
  870. MOTYPE=NOTYPE
  871. TYPE(1)='REAL*8'
  872. TYPE(2)='REAL*8'
  873. TYPE(3)='REAL*8'
  874. TYPE(4)='REAL*8'
  875. TYPE(5)='REAL*8'
  876. TYPE(6)='REAL*8'
  877. TYPE(7)='REAL*8'
  878. TYPE(8)='REAL*8'
  879. TYPE(9)='REAL*8'
  880. TYPE(10)='REAL*8'
  881. TYPE(11)='REAL*8'
  882. TYPE(12)='REAL*8'
  883. TYPE(13)='REAL*8'
  884. TYPE(14)='REAL*8'
  885. TYPE(15)='REAL*8'
  886. TYPE(16)='REAL*8'
  887. TYPE(17)='REAL*8'
  888. TYPE(18)='REAL*8'
  889. TYPE(19)='REAL*8'
  890. TYPE(20)='REAL*8'
  891. TYPE(21)='REAL*8'
  892. TYPE(22)='REAL*8'
  893. TYPE(23)='REAL*8'
  894. TYPE(24)='REAL*8'
  895. TYPE(25)='REAL*8'
  896. TYPE(26)='REAL*8'
  897. TYPE(27)='REAL*8'
  898. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  899. + AND.IFOUR.EQ.-2) TYPE(28)='REAL*8'
  900. C
  901. ELSE IF(MFR.EQ.7.AND.CMATE.EQ.'SECTION')THEN
  902. NBTYPE=3
  903. SEGINI NOTYPE
  904. MOTYPE=NOTYPE
  905. TYPE(1)='POINTEURMMODEL '
  906. TYPE(2)='POINTEURMCHAML '
  907. TYPE(3)='POINTEURLISTREEL'
  908. C
  909. ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.54)THEN
  910. NBTYPE=15
  911. SEGINI NOTYPE
  912. MOTYPE=NOTYPE
  913. DO I=1,NBTYPE
  914. TYPE(I)='REAL*8'
  915. ENDDO
  916. TYPE(10)='POINTEUREVOLUTIO'
  917. TYPE(11)='POINTEUREVOLUTIO'
  918. C
  919. C JOINT_SOFT
  920. C
  921. ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.56)THEN
  922. NBTYPE=10
  923. SEGINI NOTYPE
  924. MOTYPE=NOTYPE
  925. DO I=1,NBTYPE
  926. TYPE(I)='REAL*8'
  927. ENDDO
  928. TYPE(6)='POINTEUREVOLUTIO'
  929. TYPE(7)='POINTEUREVOLUTIO'
  930. TYPE(8)='POINTEUREVOLUTIO'
  931. C
  932. C Note: Il s'agit des parametres obligatoires. 1 et 2 sont par defaut
  933. C YOUN et NU, 3, 4 et 5 (d'apres idplas.eso modele plastique 35)
  934. C PNOR, CPLG, BETA, puis viennent les 3 courbes 6, 7 et 8, c.a.d
  935. C
  936. C
  937. ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.119)THEN
  938. C
  939. C JOINT_COAT
  940. C
  941. NBTYPE=2+3
  942. SEGINI NOTYPE
  943. MOTYPE=NOTYPE
  944. DO I=1,NBTYPE
  945. TYPE(I)='REAL*8'
  946. ENDDO
  947. TYPE(2)='POINTEUREVOLUTIO'
  948. C
  949. C Note: Il s'agit des parametres obligatoires. 1 est par defaut
  950. C KS, 2 (d'apres idplas.eso modele plastique 49) la courbe SJSB
  951. C SJCB, SJSB et SJTB.
  952. C
  953. C+PPm
  954. ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.126)THEN
  955. C
  956. C MUR_SHEAR
  957. C
  958. C 2004 NBTYPE=13+4
  959. NBTYPE=14+4
  960. SEGINI NOTYPE
  961. MOTYPE=NOTYPE
  962. DO I=1,NBTYPE
  963. TYPE(I)='REAL*8'
  964. ENDDO
  965. DO I=3,8
  966. TYPE(I)='POINTEUREVOLUTIO'
  967. ENDDO
  968.  
  969. C Note: Il s'agit des parametres obligatoires. 1 et 2 sont par defaut
  970. C YOUN et NU, 3 a 8 (d'apres idplas.eso modele plastique 63) les
  971. C courbes CUFP, CUKP, CULP, CUFM, CUKM, CULM
  972. C+PPm
  973. C
  974. C
  975. C ANCRAGE_ELIGEHAUSEN
  976. ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.91)THEN
  977. NBTYPE=11
  978. SEGINI NOTYPE
  979. MOTYPE=NOTYPE
  980. DO I=1,NBTYPE
  981. TYPE(I)='REAL*8'
  982. ENDDO
  983. C
  984. C PARFAIT_ANCRAGE
  985. C
  986. ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.92)THEN
  987. NBTYPE=14
  988. SEGINI NOTYPE
  989. MOTYPE=NOTYPE
  990. DO I=1,NBTYPE
  991. TYPE(I)='REAL*8'
  992. ENDDO
  993. C
  994. C ACIER_ANCRAGE
  995. C
  996. ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.93)THEN
  997. NBTYPE=24
  998. SEGINI NOTYPE
  999. MOTYPE=NOTYPE
  1000. DO I=1,NBTYPE
  1001. TYPE(I)='REAL*8'
  1002. ENDDO
  1003. C
  1004. C TAKEDA
  1005. C
  1006. ELSEIF(MATE.EQ.1.AND.(INPLAS.EQ.59.OR.INPLAS.EQ.60))THEN
  1007. NBTYPE=11
  1008. SEGINI NOTYPE
  1009. MOTYPE=NOTYPE
  1010. DO I=1,NBTYPE
  1011. TYPE(I)='REAL*8'
  1012. ENDDO
  1013. TYPE(3)='POINTEUREVOLUTIO'
  1014. C
  1015. C INFILL_UNI
  1016. C
  1017. ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.72)THEN
  1018. NBTYPE=12
  1019. SEGINI NOTYPE
  1020. MOTYPE=NOTYPE
  1021. DO I=1,NBTYPE
  1022. TYPE(I)='REAL*8'
  1023. ENDDO
  1024. TYPE(10)='POINTEUREVOLUTIO'
  1025. C
  1026. C CISAIL_NL
  1027. C
  1028. ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.73)THEN
  1029. NBTYPE=13
  1030. SEGINI NOTYPE
  1031. MOTYPE=NOTYPE
  1032. DO I=1,NBTYPE
  1033. TYPE(I)='REAL*8'
  1034. ENDDO
  1035. TYPE(10)='POINTEUREVOLUTIO'
  1036. TYPE(11)='POINTEUREVOLUTIO'
  1037. C
  1038. ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.74)THEN
  1039. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  1040. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  1041. NBTYPE=22
  1042. SEGINI NOTYPE
  1043. MOTYPE=NOTYPE
  1044. TYPE(1)='REAL*8'
  1045. TYPE(2)='REAL*8'
  1046. TYPE(3)='POINTEUREVOLUTIO'
  1047. TYPE(4)='POINTEUREVOLUTIO'
  1048. TYPE(5)='REAL*8'
  1049. TYPE(6)='POINTEUREVOLUTIO'
  1050. TYPE(7)='REAL*8'
  1051. TYPE(8)='POINTEUREVOLUTIO'
  1052. TYPE(9)='REAL*8'
  1053. TYPE(10)='POINTEUREVOLUTIO'
  1054. TYPE(11)='REAL*8'
  1055. TYPE(12)='REAL*8'
  1056. TYPE(13)='REAL*8'
  1057. TYPE(14)='REAL*8'
  1058. TYPE(15)='POINTEUREVOLUTIO'
  1059. TYPE(16)='REAL*8'
  1060. TYPE(17)='POINTEUREVOLUTIO'
  1061. TYPE(18)='REAL*8'
  1062. TYPE(19)='POINTEUREVOLUTIO'
  1063. TYPE(20)='REAL*8'
  1064. TYPE(21)='POINTEUREVOLUTIO'
  1065. TYPE(22)='REAL*8'
  1066. ELSE
  1067. NBTYPE=21
  1068. SEGINI NOTYPE
  1069. MOTYPE=NOTYPE
  1070. TYPE(1)='REAL*8'
  1071. TYPE(2)='REAL*8'
  1072. TYPE(3)='POINTEUREVOLUTIO'
  1073. TYPE(4)='POINTEUREVOLUTIO'
  1074. TYPE(5)='REAL*8'
  1075. TYPE(6)='POINTEUREVOLUTIO'
  1076. TYPE(7)='REAL*8'
  1077. TYPE(8)='POINTEUREVOLUTIO'
  1078. TYPE(9)='REAL*8'
  1079. TYPE(10)='POINTEUREVOLUTIO'
  1080. TYPE(11)='REAL*8'
  1081. TYPE(12)='REAL*8'
  1082. TYPE(13)='REAL*8'
  1083. TYPE(14)='POINTEUREVOLUTIO'
  1084. TYPE(15)='REAL*8'
  1085. TYPE(16)='POINTEUREVOLUTIO'
  1086. TYPE(17)='REAL*8'
  1087. TYPE(18)='POINTEUREVOLUTIO'
  1088. TYPE(19)='REAL*8'
  1089. TYPE(20)='POINTEUREVOLUTIO'
  1090. TYPE(21)='REAL*8'
  1091. ENDIF
  1092. C
  1093. ELSEIF(MATE.EQ.4.AND.INPLAS.EQ.74)THEN
  1094. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  1095. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  1096. NBTYPE=23
  1097. SEGINI NOTYPE
  1098. MOTYPE=NOTYPE
  1099. TYPE(1)='REAL*8'
  1100. TYPE(2)='REAL*8'
  1101. TYPE(3)='REAL*8'
  1102. TYPE(4)='POINTEUREVOLUTIO'
  1103. TYPE(5)='POINTEUREVOLUTIO'
  1104. TYPE(6)='REAL*8'
  1105. TYPE(7)='POINTEUREVOLUTIO'
  1106. TYPE(8)='REAL*8'
  1107. TYPE(9)='POINTEUREVOLUTIO'
  1108. TYPE(10)='REAL*8'
  1109. TYPE(11)='POINTEUREVOLUTIO'
  1110. TYPE(12)='REAL*8'
  1111. TYPE(13)='REAL*8'
  1112. TYPE(14)='REAL*8'
  1113. TYPE(15)='REAL*8'
  1114. TYPE(16)='POINTEUREVOLUTIO'
  1115. TYPE(17)='REAL*8'
  1116. TYPE(18)='POINTEUREVOLUTIO'
  1117. TYPE(19)='REAL*8'
  1118. TYPE(20)='POINTEUREVOLUTIO'
  1119. TYPE(21)='REAL*8'
  1120. TYPE(22)='POINTEUREVOLUTIO'
  1121. TYPE(23)='REAL*8'
  1122. ELSE IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  1123. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.2) THEN
  1124. NBTYPE=26
  1125. SEGINI NOTYPE
  1126. MOTYPE=NOTYPE
  1127. TYPE(1)='REAL*8'
  1128. TYPE(2)='REAL*8'
  1129. TYPE(3)='REAL*8'
  1130. TYPE(4)='REAL*8'
  1131. TYPE(5)='REAL*8'
  1132. TYPE(6)='REAL*8'
  1133. TYPE(7)='REAL*8'
  1134. TYPE(8)='POINTEUREVOLUTIO'
  1135. TYPE(9)='POINTEUREVOLUTIO'
  1136. TYPE(10)='REAL*8'
  1137. TYPE(11)='POINTEUREVOLUTIO'
  1138. TYPE(12)='REAL*8'
  1139. TYPE(13)='POINTEUREVOLUTIO'
  1140. TYPE(14)='REAL*8'
  1141. TYPE(15)='POINTEUREVOLUTIO'
  1142. TYPE(16)='REAL*8'
  1143. TYPE(17)='REAL*8'
  1144. TYPE(18)='REAL*8'
  1145. TYPE(19)='POINTEUREVOLUTIO'
  1146. TYPE(20)='REAL*8'
  1147. TYPE(21)='POINTEUREVOLUTIO'
  1148. TYPE(22)='REAL*8'
  1149. TYPE(23)='POINTEUREVOLUTIO'
  1150. TYPE(24)='REAL*8'
  1151. TYPE(25)='POINTEUREVOLUTIO'
  1152. TYPE(26)='REAL*8'
  1153. ELSE
  1154. NBTYPE=22
  1155. SEGINI NOTYPE
  1156. MOTYPE=NOTYPE
  1157. TYPE(1)='REAL*8'
  1158. TYPE(2)='REAL*8'
  1159. TYPE(3)='REAL*8'
  1160. TYPE(4)='POINTEUREVOLUTIO'
  1161. TYPE(5)='POINTEUREVOLUTIO'
  1162. TYPE(6)='REAL*8'
  1163. TYPE(7)='POINTEUREVOLUTIO'
  1164. TYPE(8)='REAL*8'
  1165. TYPE(9)='POINTEUREVOLUTIO'
  1166. TYPE(10)='REAL*8'
  1167. TYPE(11)='POINTEUREVOLUTIO'
  1168. TYPE(12)='REAL*8'
  1169. TYPE(13)='REAL*8'
  1170. TYPE(14)='REAL*8'
  1171. TYPE(15)='POINTEUREVOLUTIO'
  1172. TYPE(16)='REAL*8'
  1173. TYPE(17)='POINTEUREVOLUTIO'
  1174. TYPE(18)='REAL*8'
  1175. TYPE(19)='POINTEUREVOLUTIO'
  1176. TYPE(20)='REAL*8'
  1177. TYPE(21)='POINTEUREVOLUTIO'
  1178. TYPE(22)='REAL*8'
  1179. ENDIF
  1180. C
  1181. ELSEIF(INPLAS.EQ.67) THEN
  1182. NBTYPE=NMATR+NMATF
  1183. SEGINI NOTYPE
  1184. MOTYPE=NOTYPE
  1185. IM2=NMATR-2
  1186. DO IC=1,IM2
  1187. TYPE(IC)='REAL*8'
  1188. ENDDO
  1189. TYPE(NMATR-1)='POINTEUREVOLUTIO'
  1190. TYPE(NMATR) ='POINTEUREVOLUTIO'
  1191. DO IC=NMATR+1,NBTYPE
  1192. TYPE(IC)='REAL*8'
  1193. ENDDO
  1194. C
  1195. ELSEIF(MATE.EQ.4.AND.INPLAS.EQ.5)THEN
  1196. NBTYPE=6
  1197. SEGINI NOTYPE
  1198. MOTYPE=NOTYPE
  1199. TYPE(1)='REAL*8'
  1200. TYPE(2)='REAL*8'
  1201. TYPE(3)='REAL*8'
  1202. TYPE(4)='POINTEUREVOLUTIO'
  1203. TYPE(5)='REAL*8'
  1204. TYPE(6)='REAL*8'
  1205. C
  1206. c mistral :
  1207. ELSEIF (INPLAS.EQ.94) THEN
  1208. NBTYPE=NMATR+NMATF
  1209. SEGINI NOTYPE
  1210. MOTYPE=NOTYPE
  1211. DO 11 ITYP=1,NBTYPE
  1212. TYPE(ITYP)='REAL*8'
  1213. 11 CONTINUE
  1214. c pour le modèle mistral il y a 10 composantes non linéaires qui sont des listes de réels
  1215. NLDEB=NMATR-9
  1216. DO 13 ITYP=NLDEB,NMATR
  1217. TYPE(ITYP)='POINTEURLISTREEL'
  1218. 13 CONTINUE
  1219. c mistral.
  1220. C
  1221. ELSE
  1222. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  1223. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  1224. NBTYPE=2
  1225. ELSE
  1226. NBTYPE=1
  1227. ENDIF
  1228. SEGINI NOTYPE
  1229. MOTYPE=NOTYPE
  1230. TYPE(1)='REAL*8'
  1231. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  1232. + AND.IFOUR.EQ.-2) TYPE(2)='REAL*8'
  1233. C
  1234. ENDIF
  1235.  
  1236. CALL KOMCHA(IPCAR,IPMAIL,CONM,MOMATR,MOTYPE,1,
  1237. & INFOS,3,IVAMAT)
  1238.  
  1239. SEGSUP NOTYPE
  1240. C
  1241. IF(IERR.NE.0)THEN
  1242. KERRE=999
  1243. GOTO 9990
  1244. ENDIF
  1245. NMATT=NMATR+NMATF
  1246. *
  1247. IF (ISUP5.EQ.1) THEN
  1248. CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  1249. IF(IERR.NE.0)THEN
  1250. KERRE=999
  1251. ISUP5=0
  1252. GOTO 9990
  1253. ENDIF
  1254. ENDIF
  1255. *
  1256. * traitement du champ de caracteristiques geometriques
  1257. *
  1258. NBROBL=0
  1259. NBRFAC=0
  1260. MOCARA=0
  1261. *
  1262. * coques minces
  1263. *
  1264. IF (MFR.EQ.3.OR.MFR.EQ.9) THEN
  1265. NBROBL=1
  1266. NBRFAC=2
  1267. SEGINI NOMID
  1268. MOCARA=NOMID
  1269. LESOBL(1)='EPAI'
  1270. LESFAC(1)='CALF'
  1271. LESFAC(2)='EXCE'
  1272. *
  1273. NBTYPE=1
  1274. SEGINI NOTYPE
  1275. MOTYPE=NOTYPE
  1276. TYPE(1)='REAL*8'
  1277. ELSEIF (MFR.EQ.5) THEN
  1278. NBROBL=1
  1279. NBRFAC=1
  1280. SEGINI NOMID
  1281. MOCARA=NOMID
  1282. LESOBL(1)='EPAI'
  1283. LESFAC(1)='EXCE'
  1284. *
  1285. NBTYPE=1
  1286. SEGINI NOTYPE
  1287. MOTYPE=NOTYPE
  1288. TYPE(1)='REAL*8'
  1289. *
  1290. * section pour les barres
  1291. *
  1292. ELSE IF (MFR.EQ.27) THEN
  1293. NBROBL=1
  1294. SEGINI NOMID
  1295. MOCARA=NOMID
  1296. LESOBL(1)='SECT'
  1297. *
  1298. NBTYPE=1
  1299. SEGINI NOTYPE
  1300. MOTYPE=NOTYPE
  1301. TYPE(1)='REAL*8'
  1302. *
  1303. * section, excentrements et orientation pour les barres excentrees
  1304. *
  1305. ELSE IF (MFR.EQ.49) THEN
  1306. NBROBL=6
  1307. SEGINI NOMID
  1308. MOCARA=NOMID
  1309. LESOBL(1)='SECT'
  1310. LESOBL(2)='EXCZ'
  1311. LESOBL(3)='EXCY'
  1312. LESOBL(4)='VX '
  1313. LESOBL(5)='VY '
  1314. LESOBL(6)='VZ '
  1315. *
  1316. NBTYPE=1
  1317. SEGINI NOTYPE
  1318. MOTYPE=NOTYPE
  1319. TYPE(1)='REAL*8'
  1320. *
  1321. * raideurs locales pour l'element LIA2 de liaison a 2 noeuds
  1322. *
  1323. ELSE IF (MFR.EQ.51) THEN
  1324. NBROBL=9
  1325. SEGINI NOMID
  1326. MOCARA=NOMID
  1327. LESOBL(1)='RLUX'
  1328. LESOBL(2)='RLUY'
  1329. LESOBL(3)='RLUZ'
  1330. LESOBL(4)='RLRX'
  1331. LESOBL(5)='RLRY'
  1332. LESOBL(6)='RLRZ'
  1333. LESOBL(7)='VX '
  1334. LESOBL(8)='VY '
  1335. LESOBL(9)='VZ '
  1336. *
  1337. NBTYPE=1
  1338. SEGINI NOTYPE
  1339. MOTYPE=NOTYPE
  1340. TYPE(1)='REAL*8'
  1341. *
  1342. ELSE IF (MFR.EQ.7 ) THEN
  1343. *
  1344. * cas des poutres en formulation section
  1345. *
  1346. IF (CMATE.EQ.'SECTION') THEN
  1347. NBROBL=0
  1348. NBRFAC=1
  1349. SEGINI NOMID
  1350. MOCARA=NOMID
  1351. LESFAC(1)='VECT'
  1352. *
  1353. NBTYPE=1
  1354. SEGINI NOTYPE
  1355. MOTYPE=NOTYPE
  1356. TYPE(1)='POINTEURPOINT '
  1357. *
  1358. * Cas des poutres 2D
  1359. *
  1360. ELSE IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  1361. NBRFAC=1
  1362. NBROBL=2
  1363. SEGINI NOMID
  1364. MOCARA=NOMID
  1365. LESOBL(1)= 'SECT'
  1366. LESOBL(2)= 'INRZ'
  1367. LESFAC(1)= 'SECY'
  1368. *
  1369. NBTYPE=1
  1370. SEGINI NOTYPE
  1371. MOTYPE=NOTYPE
  1372. TYPE(1)='REAL*8'
  1373. *
  1374. * cas des poutres 3D
  1375. *
  1376. ELSE
  1377. *
  1378. * cas des autres poutres
  1379. *
  1380. NBROBL=4
  1381. NBRFAC=6
  1382. SEGINI NOMID
  1383. MOCARA=NOMID
  1384. LESOBL(1)='TORS'
  1385. LESOBL(2)='INRY'
  1386. LESOBL(3)='INRZ'
  1387. LESOBL(4)='SECT'
  1388. LESFAC(1)='SECY'
  1389. LESFAC(2)='SECZ'
  1390. LESFAC(3)='DX '
  1391. LESFAC(4)='DY '
  1392. LESFAC(5)='DZ '
  1393. LESFAC(6)='VECT'
  1394. *
  1395. NBTYPE=10
  1396. SEGINI NOTYPE
  1397. MOTYPE=NOTYPE
  1398. TYPE(1)='REAL*8'
  1399. TYPE(2)='REAL*8'
  1400. TYPE(3)='REAL*8'
  1401. TYPE(4)='REAL*8'
  1402. TYPE(5)='REAL*8'
  1403. TYPE(6)='REAL*8'
  1404. TYPE(7)='REAL*8'
  1405. TYPE(8)='REAL*8'
  1406. TYPE(9)='REAL*8'
  1407. TYPE(10)='POINTEURPOINT '
  1408. ENDIF
  1409. *
  1410. * caracteristiques pour les tuyaux
  1411. *
  1412. ELSE IF (MFR.EQ.13) THEN
  1413. NBROBL=2
  1414. NBRFAC=9
  1415. SEGINI NOMID
  1416. MOCARA=NOMID
  1417. LESOBL(1)='EPAI'
  1418. LESOBL(2)='RAYO'
  1419. LESFAC(1)='RACO'
  1420. LESFAC(2)='PRES'
  1421. LESFAC(3)='CISA'
  1422. LESFAC(4)='CFFX'
  1423. LESFAC(5)='CFMX'
  1424. LESFAC(6)='CFMY'
  1425. LESFAC(7)='CFMZ'
  1426. LESFAC(8)='CFPR'
  1427. LESFAC(9)='VECT'
  1428. *
  1429. NBTYPE=11
  1430. SEGINI NOTYPE
  1431. MOTYPE=NOTYPE
  1432. TYPE(1)='REAL*8'
  1433. TYPE(2)='REAL*8'
  1434. TYPE(3)='REAL*8'
  1435. TYPE(4)='REAL*8'
  1436. TYPE(5)='REAL*8'
  1437. TYPE(6)='REAL*8'
  1438. TYPE(7)='REAL*8'
  1439. TYPE(8)='REAL*8'
  1440. TYPE(9)='REAL*8'
  1441. TYPE(10)='REAL*8'
  1442. TYPE(11)='POINTEURPOINT '
  1443. *
  1444. * caracteristiques pour les linespring
  1445. *
  1446. ELSE IF (MFR.EQ.15) THEN
  1447. NBROBL=5
  1448. SEGINI NOMID
  1449. MOCARA=NOMID
  1450. LESOBL(1)='EPAI'
  1451. LESOBL(2)='FISS'
  1452. LESOBL(3)='VX '
  1453. LESOBL(4)='VY '
  1454. LESOBL(5)='VZ '
  1455. *
  1456. NBTYPE=1
  1457. SEGINI NOTYPE
  1458. MOTYPE=NOTYPE
  1459. TYPE(1)='REAL*8'
  1460. *
  1461. * caracteristiques pour les tuyaux fissures
  1462. *
  1463. ELSE IF (MFR.EQ.17) THEN
  1464. NBROBL=9
  1465. SEGINI NOMID
  1466. MOCARA=NOMID
  1467. LESOBL(1)='RAYO'
  1468. LESOBL(2)='EPAI'
  1469. LESOBL(3)='VX '
  1470. LESOBL(4)='VY '
  1471. LESOBL(5)='VZ '
  1472. LESOBL(6)='VXF '
  1473. LESOBL(7)='VYF '
  1474. LESOBL(8)='VZF '
  1475. LESOBL(9)='ANGL'
  1476. *
  1477. NBTYPE=1
  1478. SEGINI NOTYPE
  1479. MOTYPE=NOTYPE
  1480. TYPE(1)='REAL*8'
  1481. *
  1482. * caracteristiques des elements homogeneises
  1483. *
  1484. ELSE IF (MFR.EQ.37) THEN
  1485. IF(IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN
  1486. NBROBL=4
  1487. SEGINI NOMID
  1488. MOCARA=NOMID
  1489. LESOBL(1)='SCEL'
  1490. LESOBL(2)='SFLU'
  1491. LESOBL(3)='EPS '
  1492. LESOBL(4)='XINE'
  1493. ELSE
  1494. NBROBL=3
  1495. SEGINI NOMID
  1496. MOCARA=NOMID
  1497. LESOBL(1)='SCEL'
  1498. LESOBL(2)='SFLU'
  1499. LESOBL(3)='EPS '
  1500. ENDIF
  1501. *
  1502. NBTYPE=1
  1503. SEGINI NOTYPE
  1504. MOTYPE=NOTYPE
  1505. TYPE(1)='REAL*8'
  1506. ENDIF
  1507. *
  1508. IF(MOCARA.NE.0)THEN
  1509. CALL KOMCHA(IPCAR,IPMAIL,CONM,MOCARA,MOTYPE,1,
  1510. & INFOS,3,IVACAR)
  1511. SEGSUP NOTYPE
  1512. IF(IERR.NE.0)THEN
  1513. KERRE=999
  1514. GOTO 9990
  1515. ENDIF
  1516. ENDIF
  1517. NCARA=NBROBL
  1518. NCARF=NBRFAC
  1519. NCARR=NCARA+NCARF
  1520. *
  1521. IF (ISUP5.EQ.1.AND.MOCARA.NE.0) THEN
  1522. CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  1523. IF(IERR.NE.0)THEN
  1524. KERRE=999
  1525. ISUP5=0
  1526. GOTO 9990
  1527. ENDIF
  1528. ENDIF
  1529. *
  1530. *-------------------------------------------------
  1531. * creation des mchamls de la sous zone
  1532. *-------------------------------------------------
  1533. *
  1534. NBPTEL=NBGS
  1535. NEL=NBELEM
  1536. *
  1537. N1PTEL=NBPTEL
  1538. N1EL=NEL
  1539. N2PTEL=0
  1540. N2EL=0
  1541. *
  1542. * contraintes
  1543. *
  1544. N2=NSTRS
  1545. SEGINI MCHAML
  1546. ICHAML(ISOUS)=MCHAML
  1547. NS=1
  1548. NCOSOU=NSTRS
  1549. SEGINI MPTVAL
  1550. IVASTF=MPTVAL
  1551. NOMID=MOSTRS
  1552. SEGACT NOMID
  1553. DO 1100 ICOMP=1,NSTRS
  1554. NOMCHE(ICOMP)=LESOBL(ICOMP)
  1555. TYPCHE(ICOMP)='REAL*8'
  1556. SEGINI MELVAL
  1557. IELVAL(ICOMP)=MELVAL
  1558. IVAL(ICOMP)=MELVAL
  1559. 1100 continue
  1560. SEGDES NOMID
  1561. *
  1562. * variables internes
  1563. *
  1564. IF((MFR.EQ.7.OR.MFR.EQ.13).AND.CMATE.EQ.'SECTION')THEN
  1565. N2PTEL=NBPTEL
  1566. N2EL=NEL
  1567. ENDIF
  1568. *
  1569. N2=NVART
  1570. SEGINI MCHAM1
  1571. MCHEL1.ICHAML(ISOUS)=MCHAM1
  1572. NS=1
  1573. NCOSOU=NVART
  1574. SEGINI MPTVAL
  1575. IVARIF=MPTVAL
  1576. NOMID=MOVARI
  1577. SEGACT NOMID
  1578. *
  1579. * composantes obligatoires
  1580. *
  1581. DO 1200 ICOMP=1,NVARI
  1582. MCHAM1.NOMCHE(ICOMP)=LESOBL(ICOMP)
  1583. IF(MFR.EQ.7.AND.CMATE.EQ.'SECTION')THEN
  1584. MCHAM1.TYPCHE(ICOMP)='POINTEURMCHAML '
  1585. N1PTEL=0
  1586. N1EL=0
  1587. ELSE IF(INPLAS.EQ.74.AND.ICOMP.GT.1) THEN
  1588. MCHAM1.TYPCHE(ICOMP)='POINTEURLISTREEL'
  1589. N1PTEL=0
  1590. N1EL=0
  1591. N2PTEL=NBPTEL
  1592. N2EL=NEL
  1593. ELSE
  1594. MCHAM1.TYPCHE(ICOMP)='REAL*8'
  1595. N2PTEL=0
  1596. N2EL=0
  1597. ENDIF
  1598. SEGINI MELVAL
  1599. MCHAM1.IELVAL(ICOMP)=MELVAL
  1600. IVAL(ICOMP)=MELVAL
  1601. 1200 continue
  1602. *
  1603. * composantes facultatives
  1604. *
  1605. DO 1201 ICOMP=1,NVARF
  1606. JCOMP=ICOMP+NVARI
  1607. MCHAM1.NOMCHE(JCOMP)=LESFAC(ICOMP)
  1608. IF(INPLAS.EQ.74) THEN
  1609. MCHAM1.TYPCHE(JCOMP)='POINTEURLISTREEL'
  1610. N1PTEL=0
  1611. N1EL=0
  1612. ELSE
  1613. MCHAM1.TYPCHE(JCOMP)='REAL*8'
  1614. N2PTEL=0
  1615. N2EL=0
  1616. ENDIF
  1617. SEGINI MELVAL
  1618. MCHAM1.IELVAL(JCOMP)=MELVAL
  1619. IVAL(JCOMP)=MELVAL
  1620. 1201 continue
  1621. SEGDES NOMID
  1622. *
  1623. * deformations inelastiques
  1624. *
  1625. N1PTEL=NBPTEL
  1626. N1EL=NEL
  1627. N2=NDEF
  1628. SEGINI MCHAM2
  1629. MCHEL2.ICHAML(ISOUS)=MCHAM2
  1630. NS=1
  1631. NCOSOU=NDEF
  1632. SEGINI MPTVAL
  1633. IVADEP=MPTVAL
  1634. NOMID=MODEIN
  1635. SEGACT NOMID
  1636. DO 1300 ICOMP=1,NDEF
  1637. MCHAM2.NOMCHE(ICOMP)=LESOBL(ICOMP)
  1638. MCHAM2.TYPCHE(ICOMP)='REAL*8'
  1639. N2PTEL=0
  1640. N2EL=0
  1641. SEGINI MELVAL
  1642. MCHAM2.IELVAL(ICOMP)=MELVAL
  1643. IVAL(ICOMP)=MELVAL
  1644. 1300 continue
  1645. SEGDES NOMID
  1646. *
  1647. * traitement des champs de temperature pour les materiaux
  1648. * endommageables de lemaitre
  1649. *
  1650. IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  1651. IPH1=MCHEL3.ICHAML(ISOUS)
  1652. IPH2=MCHEL4.ICHAML(ISOUS)
  1653. IPH3=MCHEL5.ICHAML(ISOUS)
  1654. ENDIF
  1655. *
  1656. * traitement des champs de flux neutronique pour le modèle MISTRAL
  1657. c mistral :
  1658. IF (IFI.EQ.1) THEN
  1659. IPH4=MCHEL7.ICHAML(ISOUS)
  1660. IPH5=MCHEL8.ICHAML(ISOUS)
  1661. ENDIF
  1662. c mistral.
  1663. *ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
  1664. * A PROPOS DE CE QUI EST FAIT JUSTE AU DESSUS .....
  1665. *
  1666. * MLR : DANGEREUX : ON ACCEDE DIRECTEMENT AUX SOUS-ZONES
  1667. * ALORS QU'IL CONVIENDRAIT DE PASSER PAR KOMCHA
  1668. * EN ATTENDANT LA CORRECTION, ON OBLIGE
  1669. * LA DONNEE DE CHPOINTS ( CF ECOULE)
  1670. * DANS LE CAS DE LA SUCCION
  1671. *ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
  1672. *
  1673. ***********************
  1674. * SPECIAL SUCCION
  1675. *
  1676. * traitement des champs de SUCCION
  1677. *
  1678. IF (ITHHER.EQ.3) THEN
  1679. IPH1=MCHEL3.ICHAML(ISOUS)
  1680. IPH2=MCHEL4.ICHAML(ISOUS)
  1681. ENDIF
  1682. ***********************
  1683. *
  1684. * recherche des pointeurs imat et icar
  1685. *
  1686. NUMAT=0
  1687. NUCAR=0
  1688. IRET = 1
  1689. IF (INPLAS.NE.26.AND.INPLAS.NE.29) THEN
  1690. CALL CARMAT(IMODEL,IPCAR,IPMAIL,MFR,MELE,CMATE,
  1691. 1 ISUP5,INFOS,CONM,IMAT,ICAR,NUMAT,NUCAR,IRET)
  1692. ENDIF
  1693. IF(IRET.EQ.0) THEN
  1694. CALL ERREUR(715)
  1695. GOTO 9990
  1696. ENDIF
  1697. *
  1698. * recherche des dimensions du melval de hooke
  1699. *
  1700. N2PTEL=0
  1701. N2EL=0
  1702. MPTVAL=IVAMAT
  1703. DO 40 IO=1,NMATT
  1704. IF(IVAL(IO).NE.0)THEN
  1705. MELVAL=IVAL(IO)
  1706. IF (CMATE.EQ.'SECTION') THEN
  1707. N2PTEL=MAX(N2PTEL,IELCHE(/1))
  1708. N2EL =MAX(N2EL ,IELCHE(/2))
  1709. ELSE
  1710. N2PTEL=MAX(N2PTEL,VELCHE(/1))
  1711. N2EL =MAX(N2EL ,VELCHE(/2))
  1712. ENDIF
  1713. ENDIF
  1714. 40 CONTINUE
  1715. IF (N2PTEL.EQ.1.OR.NBG.EQ.1) THEN
  1716. N2PTEL=1
  1717. ELSE
  1718. N2PTEL=NBG
  1719. ENDIF
  1720. *
  1721. *****************************************************
  1722. * appel a l'ecoulement proprement dit
  1723. *****************************************************
  1724. *
  1725. * On appel les modèles élastiques linéaires
  1726. * et les modèles PLASTIQUES intégrés par
  1727. * ECOINC
  1728. *
  1729. IF (INPLAS.EQ.0.OR.
  1730. 1 INPLAS.EQ.1.OR.
  1731. 2 INPLAS.EQ.3.OR.
  1732. 2 INPLAS.EQ.4.OR.
  1733. 3 INPLAS.EQ.5.OR.
  1734. 4 INPLAS.EQ.7.OR.
  1735. 5 INPLAS.EQ.11.OR.
  1736. 7 INPLAS.EQ.12.OR.
  1737. 7 INPLAS.EQ.13.OR.
  1738. 9 INPLAS.EQ.15.OR. INPLAS.EQ.87) THEN
  1739. CALL ECOU10(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR,
  1740. 1 NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET,
  1741. 1 IVADS,IVAMAT,IVACAR,
  1742. 2 IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVART,NMATT,NCARR,
  1743. 3 CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC,
  1744. 4 N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE)
  1745. *
  1746. * On appelle les modèles VISCOPLASTIQUES et FLUAGE
  1747. * intégrés par le 'moule' d'intégration CONSTI
  1748. * L'intégration est effectuée suivant une méthode
  1749. * de Runge-Kutta
  1750. *
  1751. ELSE IF (INPLAS.EQ.17.OR.
  1752. 1 INPLAS.EQ.19.OR.
  1753. 2 INPLAS.EQ.20.OR.
  1754. 3 INPLAS.EQ.61.OR.
  1755. 3 INPLAS.EQ.63.OR.
  1756. 4 INPLAS.EQ.21.OR.
  1757. 5 INPLAS.EQ.22.OR.
  1758. 6 INPLAS.EQ.23.OR.
  1759. 7 INPLAS.EQ.24.OR.
  1760. 8 INPLAS.EQ.25.OR.
  1761. 9 INPLAS.EQ.53.OR. INPLAS.EQ.76.OR.
  1762. 9 INPLAS.EQ.44.OR. INPLAS.EQ.77.OR.
  1763. 1 INPLAS.EQ.45.OR. INPLAS.EQ.102.OR.
  1764. 2 INPLAS.EQ.70.OR.
  1765. 3 INPLAS.EQ.84.OR.
  1766. 5 INPLAS.EQ.85.OR.
  1767. 4 INPLAS.EQ.86) THEN
  1768. CALL ECOU20(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR,
  1769. 1 NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET,
  1770. 1 IVADS,IVAMAT,IVACAR,
  1771. 2 IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVART,NMATT,NCARR,
  1772. 3 CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC,
  1773. 4 N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE)
  1774. *
  1775. * On appelle les modèles VISCOPLASTIQUES et FLUAGE
  1776. * NON INTEGRES par CONSTI
  1777. *
  1778. ELSE IF (INPLAS.EQ.43.OR.INPLAS.EQ.82.OR.
  1779. 1 INPLAS.EQ.90.OR.INPLAS.EQ.94.OR.
  1780. 1 INPLAS.EQ.95.OR.INPLAS.EQ.100) THEN
  1781. CALL ECOU25(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR,
  1782. 1 NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET,
  1783. 1 IVADS,IVAMAT,IVACAR,IPH1,IPH2,IPH3,IPH4,IPH5,
  1784. 2 ITHHER,IFI,LHOOK,NSTRS,NVART,NMATT,NMATR,NCARR,
  1785. 3 CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC,
  1786. 4 N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE)
  1787.  
  1788. ELSE IF (INPLAS.EQ.65.OR.INPLAS.EQ.74) THEN
  1789. CALL ECOU21(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR,
  1790. 1 NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET,
  1791. 1 IVADS,IVAMAT,IVACAR,
  1792. 2 IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVART,NMATT,NCARR,
  1793. 3 CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC,
  1794. 4 N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE)
  1795. *
  1796. * On appele les modeles de materiaux endommageables de Lemaitre
  1797. * Ce sont des matériaux plastiques (26) et viscoplastiques (29)
  1798. * intégré par CONSTI
  1799. *
  1800. ELSE IF (INPLAS.EQ.26.OR.
  1801. 9 INPLAS.EQ.29) THEN
  1802. CALL ECOU29(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR,
  1803. 1 NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET,
  1804. 1 IVADS,IVAMAT,IVACAR,
  1805. 2 IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVART,NMATT,NCARR,
  1806. 3 CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC,
  1807. 4 N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE)
  1808. *
  1809. * On appelle les matériaux ENDOMMAGEABLE
  1810. *
  1811. ELSE IF (INPLAS.EQ.30.OR.
  1812. 1 INPLAS.EQ.31.OR.INPLAS.EQ.37.OR.
  1813. 2 INPLAS.EQ.88.OR.INPLAS.EQ.89.OR.
  1814. 3 INPLAS.EQ.96.OR.INPLAS.EQ.97.OR.
  1815. 3 INPLAS.EQ.98.OR.INPLAS.EQ.118.OR.
  1816. 4 INPLAS.EQ.134.OR.INPLAS.EQ.135.OR.INPLAS.EQ.141) THEN
  1817.  
  1818. CALL ECOU40(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR,
  1819. 1 NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET,
  1820. 1 IVADS,IVAMAT,IVACAR,
  1821. 2 IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVART,NMATT,NCARR,
  1822. 3 CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC,
  1823. 4 N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE)
  1824. *
  1825. * On appelle les matériaux PLASTIQUE_ENDOM(MAGEABLE)
  1826. *
  1827. ELSE IF (INPLAS.EQ.51.OR.
  1828. 1 INPLAS.EQ.62.OR.
  1829. 2 INPLAS.EQ.64.OR.
  1830. 3 INPLAS.EQ.75) THEN
  1831. CALL ECOU50(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR,
  1832. 1 NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET,
  1833. 1 IVADS,IVAMAT,IVACAR,
  1834. 2 IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVART,NMATT,NCARR,
  1835. 3 CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC,
  1836. 4 N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE)
  1837. *
  1838. * On appelle les matériaux PLASTIQUES qui ne sont pas
  1839. * intégrés dans ECOINC
  1840. *
  1841. *
  1842. ELSE IF (INPLAS.EQ.2.OR.INPLAS.EQ.27.OR.
  1843. 3 INPLAS.EQ.9.OR.INPLAS.EQ.14.OR.
  1844. 6 INPLAS.EQ.18.OR.INPLAS.EQ.16.OR.
  1845. 8 INPLAS.EQ.28.OR.INPLAS.EQ.32.OR.
  1846. 8 INPLAS.EQ.33.OR.INPLAS.EQ.38.OR.
  1847. 8 INPLAS.EQ.34.OR.INPLAS.EQ.35.OR.
  1848. 8 INPLAS.EQ.36.OR.INPLAS.EQ.39.OR.
  1849. 8 INPLAS.EQ.40.OR.INPLAS.EQ.41.OR.
  1850. 8 INPLAS.EQ.50.OR.INPLAS.EQ.49.OR.
  1851. 8 INPLAS.EQ.48.OR.INPLAS.EQ.42.OR.
  1852. 8 INPLAS.EQ.47.OR.INPLAS.EQ.52.OR.
  1853. 8 INPLAS.EQ.54.OR.INPLAS.EQ.55.OR.
  1854. 8 INPLAS.EQ.56.OR.INPLAS.EQ.57.OR.
  1855. 8 INPLAS.EQ.58.OR.INPLAS.EQ.59.OR.
  1856. 9 INPLAS.EQ.60.OR.INPLAS.EQ.78.OR.
  1857. 9 INPLAS.EQ.79.OR.INPLAS.EQ.80.OR.
  1858. 9 INPLAS.EQ.91.OR.INPLAS.EQ.92.OR.
  1859. 9 INPLAS.EQ.93.OR.INPLAS.EQ.119.OR.INPLAS.EQ.126) THEN
  1860. CALL ECOU60(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR,
  1861. 1 NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET,
  1862. 1 IVADS,IVAMAT,IVACAR,
  1863. 2 IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVART,NMATT,NCARR,
  1864. 3 CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC,
  1865. 4 N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE)
  1866. *
  1867. *
  1868. * On appelle les matériaux PLASTIQUES qui ne sont pas
  1869. * integres dans ECOINC - SUITE de ECOU60
  1870. *
  1871. ELSE IF (INPLAS.EQ.66.OR.INPLAS.EQ.67.OR.
  1872. 1 INPLAS.EQ.68.OR.INPLAS.EQ.69.OR.
  1873. 2 INPLAS.EQ.71.OR.INPLAS.EQ.72.OR.
  1874. 2 INPLAS.EQ.73.OR.INPLAS.EQ.99.OR.
  1875. 3 INPLAS.EQ.101) THEN
  1876. CALL ECOU70(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR,
  1877. 1 NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET,
  1878. 1 IVADS,IVAMAT,IVACAR,
  1879. 2 IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVART,NMATT,NMATR,NCARR,
  1880. 3 CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC,
  1881. 4 N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE)
  1882. *
  1883. ELSE
  1884. KERRE=99
  1885. ENDIF
  1886. *
  1887. ***************************************************
  1888. * Fin de l'appel aux modeles d'ecoulement
  1889. ***************************************************
  1890. 9990 CONTINUE
  1891. *
  1892. * desactivation des segments
  1893. *
  1894. SEGDES MELEME*NOMOD,IMODEL*NOMOD
  1895. SEGDES,MINTE
  1896. *
  1897. IF(ISUP1.EQ.1)THEN
  1898. CALL DTMVAL (IVASTR,3)
  1899. ELSE
  1900. CALL DTMVAL (IVASTR,1)
  1901. ENDIF
  1902. IF(ISUP2.EQ.1)THEN
  1903. CALL DTMVAL (IVARI,3)
  1904. ELSE
  1905. CALL DTMVAL (IVARI,1)
  1906. ENDIF
  1907. IF(ISUP3.EQ.1)THEN
  1908. CALL DTMVAL (IVADEF,3)
  1909. ELSE
  1910. CALL DTMVAL (IVADEF,1)
  1911. ENDIF
  1912. IF(ISUP4.EQ.1)THEN
  1913. CALL DTMVAL (IVADS,3)
  1914. ELSE
  1915. CALL DTMVAL (IVADS,1)
  1916. ENDIF
  1917. IF(ISUP5.EQ.1)THEN
  1918. CALL DTMVAL (IVAMAT,3)
  1919. ELSE
  1920. CALL DTMVAL (IVAMAT,1)
  1921. ENDIF
  1922. IF(ISUP5.EQ.1)THEN
  1923. CALL DTMVAL (IVACAR,3)
  1924. ELSE
  1925. CALL DTMVAL (IVACAR,1)
  1926. ENDIF
  1927. IF(ISUP6.EQ.1)THEN
  1928. CALL DTMVAL (IVADET,3)
  1929. ELSE IF(IPCHE6.NE.0) THEN
  1930. CALL DTMVAL (IVADET,1)
  1931. ENDIF
  1932. IF (KERRE.EQ.0) THEN
  1933. CALL DTMVAL (IVASTF,1)
  1934. CALL DTMVAL (IVARIF,1)
  1935. CALL DTMVAL (IVADEP,1)
  1936. SEGDES MCHAML,MCHAM1,MCHAM2
  1937. ELSE
  1938. CALL DTMVAL (IVASTF,3)
  1939. CALL DTMVAL (IVARIF,3)
  1940. CALL DTMVAL (IVADEP,3)
  1941. IF (MCHAML.NE.0) SEGSUP MCHAML
  1942. IF (MCHAM1.NE.0) SEGSUP MCHAM1
  1943. IF (MCHAM2.NE.0) SEGSUP MCHAM2
  1944. END IF
  1945. *
  1946. IF (MOCARA.NE.0) THEN
  1947. NOMID=MOCARA
  1948. SEGSUP NOMID
  1949. END IF
  1950. *
  1951. IF (MOMATR.NE.0) THEN
  1952. NOMID=MOMATR
  1953. if(lsupma)SEGSUP NOMID
  1954. END IF
  1955. *
  1956. IF (MOVARI.NE.0) THEN
  1957. NOMID=MOVARI
  1958. if(lsupva)SEGSUP NOMID
  1959. END IF
  1960. *
  1961. IF (MOSTRS.NE.0) THEN
  1962. NOMID=MOSTRS
  1963. if(lsupco)SEGSUP NOMID
  1964. END IF
  1965. *
  1966. IF (MOEPSI.NE.0) THEN
  1967. NOMID=MOEPSI
  1968. if(lsupde)SEGSUP NOMID
  1969. END IF
  1970. IF (MODEIN.NE.0) THEN
  1971. NOMID=MODEIN
  1972. if(lsupdd)SEGSUP NOMID
  1973. END IF
  1974. *
  1975. * IF (IPINF .NE.0) THEN
  1976. * INFO=IPINF
  1977. * SEGSUP INFO
  1978. * END IF
  1979. *
  1980. IF(KERRE.NE.0)GO TO 888
  1981. 1000 continue
  1982. *
  1983. 888 CONTINUE
  1984. *
  1985. * traitement des champs de temperature pour les materiaux
  1986. * endommageables de lemaitre
  1987. *
  1988. IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  1989. SEGDES MCHEL3,MCHEL4,MCHEL5
  1990. ENDIF
  1991. c mistral :
  1992. IF (IFI.EQ.1) THEN
  1993. SEGDES MCHEL7,MCHEL8
  1994. ENDIF
  1995. c mistral.
  1996. ***********************
  1997. * SPECIAL SUCCION
  1998. *
  1999. IF (ITHHER.EQ.3) THEN
  2000. SEGDES MCHEL3,MCHEL4
  2001. ENDIF
  2002. ***********************
  2003. *
  2004. IF(IPCHE6.NE.0) THEN
  2005. SEGDES MCHEL6
  2006. ENDIF
  2007. *
  2008. SEGDES MMODEL*NOMOD
  2009. IF(KERRE.EQ.0)THEN
  2010. SEGDES MCHELM,MCHEL1,MCHEL2
  2011. ELSE
  2012. SEGSUP MCHELM,MCHEL1,MCHEL2
  2013. ENDIF
  2014. *
  2015. RETURN
  2016. END
  2017.  
  2018.  
  2019.  
  2020.  
  2021.  
  2022.  
  2023.  
  2024.  
  2025.  
  2026.  
  2027.  

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