Télécharger ecoul1.eso

Retour à la liste

Numérotation des lignes :

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

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