Télécharger ecoul1.eso

Retour à la liste

Numérotation des lignes :

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

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