Télécharger critp.eso

Retour à la liste

Numérotation des lignes :

critp
  1. C CRITP SOURCE CB215821 20/11/04 21:15:55 10766
  2. SUBROUTINE CRITP(IPMODL,IPCHE1,IPCHE2,IPCAR,IPCHE3)
  3. *******************************************************************
  4. *
  5. * CALCUL LE CRITERE DE PLASTICITE
  6. *
  7. **********************************************************************
  8. *
  9. * ENTREES:
  10. *
  11. * IPMODL = POINTEUR SUR UN OBJET MMODEL
  12. * IPCHE1 = POINTEUR SUR UN MCHAML DE CONTRAINTES
  13. * IPCHE2 = POINTEUR SUR UN MCHAML DE VARIABLES INTERNES
  14. * IPCAR = POINTEUR SUR UN MCHAML DE CARACTERISTIQUES
  15. *
  16. * SORTIES:
  17. *
  18. * IPCHE3 = POINTEUR SUR UN MCHAML SCALAIRE
  19. *
  20. ************************************************************************
  21. IMPLICIT INTEGER(I-N)
  22. IMPLICIT REAL*8(A-H,O-Z)
  23. *
  24.  
  25. -INC PPARAM
  26. -INC CCOPTIO
  27. -INC SMCHAML
  28. -INC SMELEME
  29. -INC SMCOORD
  30. -INC SMMODEL
  31. -INC SMINTE
  32. -INC CCHAMP
  33. C----------------------------------------------------------------------
  34. C KERRE REGIT LES MESSAGES D'ERREUR DANS CRIT
  35. C
  36. C = 0 TOUT OK
  37. C = 1 ET 2 S ALIGNER SUR LES VALEURS DONNEES PAR ECOCRI
  38. C = 7 UN ELEMENT TUYAU A UNE EPAISSEUR NULLE
  39. C
  40. C ANOMALIES AVEC LA COURBE DE TRACTION
  41. C = 30 LIMITE ELASTIQUE NULLE
  42. C = 31 TROP DE POINTS
  43. C = 32 PAS ASSEZ DE POINTS
  44. C = 33 PENTE INCORRECTE
  45. C = 34 MODULE D'YOUNG NUL
  46. C = 35 MANQUE L'ORIGINE
  47. C = 36 PENTE A L'ORIGINE NON EGALE A E
  48. C = 37 MANQUE LA COURBE DE TRACTION
  49. C = 48 DONNEES DRUCKER-PRAGER ERRONNEES
  50. C = 99 CAS NON ENCORE DISPONIBLE
  51. C----------------------------------------------------------------------
  52. C
  53. SEGMENT NOTYPE
  54. CHARACTER*16 TYPE(NBTYPE)
  55. ENDSEGMENT
  56. *
  57. SEGMENT MPTVAL
  58. INTEGER IPOS(NS) ,NSOF(NS)
  59. INTEGER IVAL(NCOSOU)
  60. CHARACTER*16 TYVAL(NCOSOU)
  61. ENDSEGMENT
  62. *
  63. SEGMENT WRK0
  64. REAL*8 XMAT(NCXMAT)
  65. ENDSEGMENT
  66. *
  67. SEGMENT WRK1
  68. REAL*8 DDHOOK(NSTRS,NSTRS),SIG0(NSTRS),DSIGT(NSTRS)
  69. REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  70. REAL*8 DEFP(NSTRS),XCAR(ICARA)
  71. ENDSEGMENT
  72. *
  73. SEGMENT WRK2
  74. REAL*8 TRAC(LTRAC)
  75. ENDSEGMENT
  76. *
  77. SEGMENT WRK3
  78. REAL*8 WORK(LW),WORK2(LW2)
  79. ENDSEGMENT
  80. *
  81. SEGMENT WRK4
  82. REAL*8 XE(3,NBBB)
  83. ENDSEGMENT
  84. *
  85. SEGMENT ECOU
  86. *** COMMON/ECOU/TEST,ALFAH,
  87. REAL*8 TEST,ALFAH,
  88. C REAL*8 TEST, ALFAH,
  89. 1 HPAS, TEMPS,ecow3(6),ecow4(9),ecow5(6),
  90. C 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
  91. 2 ecow6(12),ecow7(6),ecow8(6),ecow9(6),ecow10(6),ecow11(6),
  92. 2 ecow12(6),
  93. C 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6),
  94. 1 ecow13(6),ecow14(6),ecow15(12),ecow16(3),
  95. C 1 DALPHA(6),EPSPLA(6),E(12),XINV(3),
  96. 2 ecow17(6),ecow18(6),ecow19,ecow20
  97. C 2 SIPLAD(6),DSIGP0(6),TET,TETI
  98. ENDSEGMENT
  99.  
  100. SEGMENT NECOU
  101. * COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  102. INTEGER NCOURB, IPLAST,IT,IMAPLA, ISOTRO,
  103. C INTEGER NCOURB,IPLAST,IT, IMAPLA,ISOTRO,
  104. 1 ITYP, IFOURB, IFLUAG,
  105. C . ITYP, IFOURB,IFLUAG,
  106. 2 ICINE,ITHER, IFLUPL,ICYCL, IBI,
  107. C . ICINE,ITHER, IFLUPL,ICYCL, IBI,
  108. 3 JFLUAG,KFLUAG, LFLUAG,
  109. C . JFLUAG,KFLUAG,LFLUAG,
  110. 4 IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEP
  111. C . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
  112. ENDSEGMENT
  113. * COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  114. * . ITYP,IFOURB,IFLUAG,
  115. * . ICINE,ITHER,IFLUPL,ICYCL,IBI,
  116. * . JFLUAG,KFLUAG,LFLUAG,
  117. * . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
  118.  
  119. DIMENSION MOMAT(2)
  120. DIMENSION XEPOU(2),YEPOU(2),ZEPOU(2)
  121. DIMENSION BID(3)
  122. *
  123. CHARACTER*8 CMATE
  124. CHARACTER*(NCONCH) CONM
  125. PARAMETER ( NINF=3 )
  126. INTEGER INFOS(NINF)
  127. LOGICAL LSUPVA,lsupco,lsupma
  128. DATA IUN,IZERO/1,0/
  129. DATA UN,XZER,UNDEMI/1.D0,0.D0,.5D0/
  130. C
  131. NHRM=NIFOUR
  132. C
  133. C VERIFICATION DU LIEU SUPPORT DU MCHAML DE CONTRAINTES
  134. C
  135. CALL QUESUP(IPMODL,IPCHE1,5,0,ISUP1,IRET1)
  136. IF (ISUP1.GT.1) RETURN
  137. C
  138. C VERIFICATION DU LIEU SUPPORT DU MCHAML DE VARIABLES INTERNES
  139. C
  140. CALL QUESUP(IPMODL,IPCHE2,5,0,ISUP2,IRET2)
  141. IF (ISUP2.GT.1) RETURN
  142. C
  143. C VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES
  144. C
  145. CALL QUESUP(IPMODL,IPCAR,5,0,ISUP3,IRET3)
  146. IF (ISUP3.GT.1) RETURN
  147. C
  148. C ACTIVATION DU MODELE
  149. C
  150. MMODEL=IPMODL
  151. SEGACT MMODEL
  152. NSOUS=KMODEL(/1)
  153. C
  154. C CREATION DU MCHAML
  155. C
  156. N1=NSOUS
  157. L1=8
  158. N3=6
  159. SEGINI MCHELM
  160. TITCHE='SCALAIRE'
  161. IFOCHE=IFOUR
  162. IPCHE3=MCHELM
  163. C____________________________________________________________________
  164. C
  165. C DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
  166. C____________________________________________________________________
  167. C
  168. DO 500 ISOUS=1,NSOUS
  169. *
  170. * INITIALISATION
  171. *
  172. segini necou,ecou
  173. NSTR=0
  174. MOSTRS=0
  175. IVASTR=0
  176. MOVARI=0
  177. NVARI=0
  178. IVARI=0
  179. NCARA=0
  180. NCARF=0
  181. MOCARA=0
  182. IVACAR=0
  183. NMATF=0
  184. NMATR=0
  185. MOMATR=0
  186. IVAMAT=0
  187. IMELCR=0
  188. KERRE=0
  189. KERR1=0
  190. lsupma=.true.
  191. lsupva=.false.
  192. C
  193. C ON RECUPERE L INFORMATION GENERALE
  194. C
  195. IMODEL=KMODEL(ISOUS)
  196. SEGACT IMODEL
  197. IPMAIL=IMAMOD
  198. CONM =CONMOD
  199. IMACHE(ISOUS)=IPMAIL
  200. CONCHE(ISOUS)=CONMOD
  201. *
  202. MELE=NEFMOD
  203. MELEME=IMAMOD
  204. SEGACT MELEME
  205. NBNN=NUM(/1)
  206. NBELEM=NUM(/2)
  207. C
  208. C TRAITEMENT DU MODELE
  209. C
  210. C
  211. C COQUE INTEGREE OU PAS ?
  212. C
  213. IF(INFMOD(/1).NE.0)THEN
  214. NPINT=INFMOD(1)
  215. ELSE
  216. NPINT=0
  217. ENDIF
  218. IF (NPINT.NE.0)THEN
  219. CALL ERREUR(615)
  220. SEGDES IMODEL,MMODEL
  221. SEGSUP MCHELM
  222. RETURN
  223. ENDIF
  224. C
  225. C NATURE DU MATERIAU
  226. C
  227. C* NFOR=FORMOD(/2)
  228. C* NMAT=MATMOD(/2)
  229. C* CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INPLAS)
  230. CMATE = CMATEE
  231. MATE = IMATEE
  232. INPLAS = INATUU
  233. C* IF (CMATE.EQ.' ')THEN
  234. C* CALL ERREUR(251)
  235. C* SEGDES IMODEL,MMODEL
  236. C* SEGSUP MCHELM
  237. C* RETURN
  238. C* ENDIF
  239. C____________________________________________________________________
  240. C
  241. C INFORMATION SUR L'ELEMENT FINI
  242. C____________________________________________________________________
  243. C
  244. * CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  245. * IF (IERR.NE.0) THEN
  246. * SEGDES IMODEL,MMODEL
  247. * SEGSUP MCHELM
  248. * RETURN
  249. * ENDIF
  250. MFR =INFELE(13)
  251. NBG =INFELE(6)
  252. NBGS =INFELE(4)
  253. NSTRS=INFELE(16)
  254. LRE =INFELE(9)
  255. IPPORE=0
  256. IF(MFR.EQ.33) IPPORE=NBNN
  257. LW =200
  258. LW2=150
  259. LHOOK=INFELE(10)
  260. LHOO2=LHOOK*LHOOK
  261. * MINTE=INFELE(11)
  262. minte=infmod(7)
  263. *
  264. IPMINT=MINTE
  265. SEGACT,MINTE
  266. *
  267. * REMPLISSAGE DES TABLEAUX INFCHE
  268. *
  269. INFCHE(ISOUS,1)=0
  270. INFCHE(ISOUS,2)=0
  271. INFCHE(ISOUS,3)=NHRM
  272. INFCHE(ISOUS,4)=MINTE
  273. INFCHE(ISOUS,5)=0
  274. INFCHE(ISOUS,6)=5
  275. C
  276. C CREATION DU TABLEAU INFOS
  277. C
  278. CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  279. IF (IRTD.EQ.0)THEN
  280. SEGDES IMODEL,MMODEL
  281. SEGSUP MCHELM
  282. RETURN
  283. ENDIF
  284. *
  285. * TRAITEMENT DU CHAMP DE CONTRAINTES
  286. *
  287. if(lnomid(4).ne.0) then
  288. nomid=lnomid(4)
  289. segact nomid
  290. mostrs=nomid
  291. nstr=lesobl(/2)
  292. nfac=lesfac(/2)
  293. lsupco=.false.
  294. else
  295. lsupco=.true.
  296. CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC)
  297. endif
  298. IF (MOSTRS.EQ.0) THEN
  299. MOTERR(1:4)='CONT'
  300. MOTERR(5:8)=NOMTP(MELE)
  301. CALL ERREUR (76)
  302. SEGDES IMODEL,MMODEL
  303. SEGSUP MCHELM
  304. RETURN
  305. ENDIF
  306. *
  307. NBTYPE=1
  308. SEGINI NOTYPE
  309. MOTYPE=NOTYPE
  310. TYPE(1)='REAL*8'
  311. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOSTRS,MOTYPE,1,INFOS,3,IVASTR)
  312. IF(IERR.NE.0)THEN
  313. SEGSUP NOTYPE
  314. KERRE=999
  315. GOTO 9990
  316. ENDIF
  317. *
  318. IF (ISUP1.EQ.1) THEN
  319. CALL VALCHE(IVASTR,NSTR,IPMINT,IPPORE,MOSTRS,MELE)
  320. IF(IERR.NE.0)THEN
  321. SEGSUP NOTYPE
  322. KERRE=999
  323. ISUP1=0
  324. GOTO 9990
  325. ENDIF
  326. ENDIF
  327. *
  328. * TRAITEMENT DU CHAMP DE VARIABLES INTERNES
  329. *
  330. if(lnomid(10).ne.0) then
  331. nomid=lnomid(10)
  332. segact nomid
  333. movari=nomid
  334. nvari=lesobl(/2)
  335. nvarf=lesfac(/2)
  336. else
  337. lsupva=.true.
  338. CALL IDVARI(MFR,IMODEL,MOVARI,NVARI,NVARF)
  339. endif
  340.  
  341. IF (MOVARI.EQ.0) THEN
  342. MOTERR(1:4)='VARI'
  343. MOTERR(5:8)=NOMTP(MELE)
  344. CALL ERREUR (76)
  345. KERRE=999
  346. SEGSUP NOTYPE
  347. GOTO 9990
  348. ENDIF
  349. *
  350. CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOVARI,MOTYPE,1,INFOS,3,IVARI)
  351. SEGSUP NOTYPE
  352. IF(IERR.NE.0)THEN
  353. KERRE=999
  354. GOTO 9990
  355. ENDIF
  356. *
  357. IF (ISUP2.EQ.1) THEN
  358. CALL VALCHE(IVARI,NVARI,IPMINT,IPPORE,MOVARI,MELE)
  359. IF(IERR.NE.0)THEN
  360. KERRE=999
  361. ISUP2=0
  362. GOTO 9990
  363. ENDIF
  364. ENDIF
  365. *
  366. * TRAITEMENT DU CHAMP DE CARACTERISTIQUES MATERIELLES
  367. *
  368. if(lnomid(6).ne.0) then
  369. nomid=lnomid(6)
  370. segact nomid
  371. momatr=nomid
  372. nmatr=lesobl(/2)
  373. nmatf=lesfac(/2)
  374. lsupma=.false.
  375. else
  376. lsupma=.true.
  377. CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  378. endif
  379. IF (MOMATR.EQ.0) THEN
  380. MOTERR(1:4)='MATE'
  381. MOTERR(5:8)=NOMTP(MELE)
  382. CALL ERREUR (76)
  383. KERRE=999
  384. GOTO 9990
  385. ENDIF
  386. *
  387. NOTYPE=0
  388. IF(INPLAS.EQ.5)THEN
  389. NBTYPE=5
  390. SEGINI NOTYPE
  391. TYPE(1)='REAL*8'
  392. TYPE(2)='REAL*8'
  393. TYPE(3)='POINTEUREVOLUTIO'
  394. TYPE(4)='REAL*8'
  395. TYPE(5)='REAL*8'
  396. ELSE IF (INPLAS.EQ.14) THEN
  397. NBTYPE=9
  398. SEGINI NOTYPE
  399. TYPE(1)='REAL*8'
  400. TYPE(2)='REAL*8'
  401. TYPE(3)='REAL*8'
  402. TYPE(4)='REAL*8'
  403. TYPE(5)='REAL*8'
  404. TYPE(6)='POINTEUREVOLUTIO'
  405. TYPE(7)='POINTEUREVOLUTIO'
  406. TYPE(8)='REAL*8'
  407. TYPE(9)='REAL*8'
  408. ELSE IF (INPLAS.EQ.26) THEN
  409. NBTYPE=8
  410. SEGINI NOTYPE
  411. TYPE(1)='REAL*8'
  412. TYPE(2)='REAL*8'
  413. TYPE(3)='POINTEUREVOLUTIO'
  414. TYPE(4)='REAL*8'
  415. TYPE(5)='REAL*8'
  416. TYPE(6)='REAL*8'
  417. TYPE(7)='REAL*8'
  418. TYPE(8)='REAL*8'
  419. ELSEIF(INPLAS.EQ.29)THEN
  420. NBTYPE=13
  421. SEGINI NOTYPE
  422. TYPE(1)='REAL*8'
  423. TYPE(2)='REAL*8'
  424. TYPE(3)='REAL*8'
  425. TYPE(4)='REAL*8'
  426. TYPE(5)='REAL*8'
  427. TYPE(6)='REAL*8'
  428. TYPE(7)='REAL*8'
  429. TYPE(8)='REAL*8'
  430. TYPE(9)='REAL*8'
  431. TYPE(10)='POINTEUREVOLUTIO'
  432. TYPE(11)='REAL*8'
  433. TYPE(12)='REAL*8'
  434. TYPE(13)='REAL*8'
  435. ELSEIF(INPLAS.EQ.16)THEN
  436. NBTYPE=7
  437. SEGINI NOTYPE
  438. TYPE(1)='REAL*8'
  439. TYPE(2)='REAL*8'
  440. TYPE(3)='POINTEUREVOLUTIO'
  441. TYPE(4)='REAL*8'
  442. TYPE(5)='REAL*8'
  443. TYPE(6)='REAL*8'
  444. TYPE(7)='REAL*8'
  445. ELSEIF(INPLAS.EQ.2)THEN
  446. NBTYPE=6
  447. SEGINI NOTYPE
  448. TYPE(1)='REAL*8'
  449. TYPE(2)='REAL*8'
  450. TYPE(3)='REAL*8'
  451. TYPE(4)='POINTEUREVOLUTIO'
  452. TYPE(5)='REAL*8'
  453. TYPE(6)='REAL*8'
  454. ELSE
  455. NBTYPE=1
  456. SEGINI NOTYPE
  457. TYPE(1)='REAL*8'
  458. ENDIF
  459. MOTYPE=NOTYPE
  460. CALL KOMCHA(IPCAR,IPMAIL,CONM,MOMATR,MOTYPE,1,
  461. & INFOS,3,IVAMAT)
  462. SEGSUP NOTYPE
  463. IF(IERR.NE.0)THEN
  464. KERRE=999
  465. GOTO 9990
  466. ENDIF
  467. NMATT=NMATR+NMATF
  468. *
  469. IF (ISUP3.EQ.1) THEN
  470. CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  471. IF(IERR.NE.0)THEN
  472. KERRE=999
  473. ISUP3=0
  474. GOTO 9990
  475. ENDIF
  476. ENDIF
  477. *
  478. * TRAITEMENT DU CHAMP DE CARACTERISTIQUES GEOMETRIQUES
  479. *
  480. NBROBL=0
  481. NBRFAC=0
  482. NOMID =0
  483. IVECT=0
  484. *
  485. * COQUES MINCES
  486. *
  487. IF (MFR.EQ.3.OR.MFR.EQ.9) THEN
  488. NBROBL=1
  489. NBRFAC=2
  490. SEGINI NOMID
  491. LESOBL(1)='EPAI'
  492. LESFAC(1)='CALF'
  493. LESFAC(2)='EXCE'
  494. *
  495. NBTYPE=1
  496. SEGINI NOTYPE
  497. TYPE(1)='REAL*8'
  498. ELSEIF (MFR.EQ.5) THEN
  499. NBROBL=1
  500. NBRFAC=1
  501. SEGINI NOMID
  502. LESOBL(1)='EPAI'
  503. LESFAC(1)='EXCE'
  504. *
  505. NBTYPE=1
  506. SEGINI NOTYPE
  507. TYPE(1)='REAL*8'
  508. *
  509. * SECTION POUR LES BARRES
  510. *
  511. ELSE IF (MFR.EQ.27) THEN
  512. NBROBL=1
  513. SEGINI NOMID
  514. LESOBL(1)='SECT'
  515. *
  516. NBTYPE=1
  517. SEGINI NOTYPE
  518. TYPE(1)='REAL*8'
  519. *
  520. * CARACTERISTIQUES POUR LES POUTRES
  521. *
  522. ELSE IF (MFR.EQ.7 ) THEN
  523. NBROBL=4
  524. NBRFAC=6
  525. SEGINI NOMID
  526. LESOBL(1)='TORS'
  527. LESOBL(2)='INRY'
  528. LESOBL(3)='INRZ'
  529. LESOBL(4)='SECT'
  530. LESFAC(1)='SECY'
  531. LESFAC(2)='SECZ'
  532. LESFAC(3)='DX '
  533. LESFAC(4)='DY '
  534. LESFAC(5)='DZ '
  535. LESFAC(6)='VECT'
  536. IVECT=1
  537. *
  538. NBTYPE=10
  539. SEGINI NOTYPE
  540. TYPE(1)='REAL*8'
  541. TYPE(2)='REAL*8'
  542. TYPE(3)='REAL*8'
  543. TYPE(4)='REAL*8'
  544. TYPE(5)='REAL*8'
  545. TYPE(6)='REAL*8'
  546. TYPE(7)='REAL*8'
  547. TYPE(8)='REAL*8'
  548. TYPE(9)='REAL*8'
  549. TYPE(10)='POINTEURPOINT '
  550.  
  551. *
  552. * CARACTERISTIQUES POUR LES TUYAUX
  553. *
  554. ELSE IF (MFR.EQ.13) THEN
  555. NBROBL=2
  556. NBRFAC=9
  557. SEGINI NOMID
  558. LESOBL(1)='EPAI'
  559. LESOBL(2)='RAYO'
  560. LESFAC(1)='RACO'
  561. LESFAC(2)='PRES'
  562. LESFAC(3)='CISA'
  563. LESFAC(4)='CFFX'
  564. LESFAC(5)='CFMX'
  565. LESFAC(6)='CFMY'
  566. LESFAC(7)='CFMZ'
  567. LESFAC(8)='CFPR'
  568. LESFAC(9)='VECT'
  569. IVECT=1
  570. *
  571. NBTYPE=11
  572. SEGINI NOTYPE
  573. TYPE(1)='REAL*8'
  574. TYPE(2)='REAL*8'
  575. TYPE(3)='REAL*8'
  576. TYPE(4)='REAL*8'
  577. TYPE(5)='REAL*8'
  578. TYPE(6)='REAL*8'
  579. TYPE(7)='REAL*8'
  580. TYPE(8)='REAL*8'
  581. TYPE(9)='REAL*8'
  582. TYPE(10)='REAL*8'
  583. TYPE(11)='POINTEURPOINT '
  584. *
  585. * CARACTERISTIQUES POUR LES LINESPRING
  586. *
  587. ELSE IF (MFR.EQ.15) THEN
  588. NBROBL=5
  589. SEGINI NOMID
  590. LESOBL(1)='EPAI'
  591. LESOBL(2)='FISS'
  592. LESOBL(3)='VX '
  593. LESOBL(4)='VY '
  594. LESOBL(5)='VZ '
  595. *
  596. NBTYPE=1
  597. SEGINI NOTYPE
  598. TYPE(1)='REAL*8'
  599. *
  600. * CARACTERISTIQUES POUR LES TUYAUX FISSURES
  601. *
  602. ELSE IF (MFR.EQ.17) THEN
  603. NBROBL=9
  604. SEGINI NOMID
  605. LESOBL(1)='RAYO'
  606. LESOBL(2)='EPAI'
  607. LESOBL(3)='VX '
  608. LESOBL(4)='VY '
  609. LESOBL(5)='VZ '
  610. LESOBL(6)='VXF '
  611. LESOBL(7)='VYF '
  612. LESOBL(8)='VZF '
  613. LESOBL(9)='ANGL'
  614. *
  615. NBTYPE=1
  616. SEGINI NOTYPE
  617. TYPE(1)='REAL*8'
  618. *
  619. * CARACTERISTIQUES DES ELEMENTS HOMOGENEISES
  620. *
  621. ELSE IF (MFR.EQ.37) THEN
  622. IF(IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN
  623. NBROBL=4
  624. SEGINI NOMID
  625. LESOBL(1)='SCEL'
  626. LESOBL(2)='SFLU'
  627. LESOBL(3)='EPS '
  628. LESOBL(4)='XINE'
  629. ELSE
  630. NBROBL=3
  631. SEGINI NOMID
  632. LESOBL(1)='SCEL'
  633. LESOBL(2)='SFLU'
  634. LESOBL(3)='EPS '
  635. ENDIF
  636. *
  637. NBTYPE=1
  638. SEGINI NOTYPE
  639. TYPE(1)='REAL*8'
  640. ENDIF
  641. *
  642. MOCARA=NOMID
  643. NCARA=NBROBL
  644. NCARF=NBRFAC
  645. NCARR=NCARA+NCARF
  646.  
  647. IF(MOCARA.NE.0)THEN
  648. MOTYPE=NOTYPE
  649. CALL KOMCHA(IPCAR,IPMAIL,CONM,MOCARA,MOTYPE,1,
  650. & INFOS,3,IVACAR)
  651. SEGSUP NOTYPE
  652. IF(IERR.NE.0)THEN
  653. KERRE=999
  654. GOTO 9990
  655. ENDIF
  656. *
  657. IF (IVECT.EQ.1) THEN
  658. MPTVAL=IVACAR
  659. IF (IVAL(NCARR).EQ.0) THEN
  660. *
  661. * MOT CLE VECT EN CAS DE CONVERSION
  662. *
  663. IVECT=2
  664. NOMID=MOCARA
  665. SEGACT NOMID
  666. NBRFAC=NBRFAC+2
  667. SEGADJ NOMID
  668. MOCARA=NOMID
  669. LESFAC(NBRFAC-2)='VX '
  670. LESFAC(NBRFAC-1)='VY '
  671. LESFAC(NBRFAC )='VZ '
  672.  
  673. NCARF=NBRFAC
  674. NCARR=NCARA+NCARF
  675. *
  676. NBTYPE=1
  677. SEGINI NOTYPE
  678. MOTYPE=NOTYPE
  679. TYPE(1)='REAL*8'
  680. *
  681. CALL KOMCHA(IPCAR,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,
  682. & IVACAR)
  683. SEGSUP NOTYPE
  684. IF (IERR.NE.0) THEN
  685. KERRE=999
  686. GOTO 9990
  687. ENDIF
  688. ENDIF
  689. ENDIF
  690. *
  691. IF (ISUP3.EQ.1) THEN
  692. CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  693. IF(IERR.NE.0)THEN
  694. KERRE=999
  695. ISUP3=0
  696. GOTO 9990
  697. ENDIF
  698. ENDIF
  699. ENDIF
  700. ICARA=NCARR
  701. IF((MFR.EQ.7.OR.MFR.EQ.13).AND.IVECT.EQ.1)ICARA=NCARR+IDIM-1
  702. *
  703. * CREATION DES MCHAMLS DE LA SOUS ZONE
  704. *
  705. NBPTEL=NBGS
  706. NEL=NBELEM
  707. N1PTEL=NBPTEL
  708. N1EL=NEL
  709. *
  710. N2=1
  711. SEGINI MCHAML
  712. ICHAML(ISOUS)=MCHAML
  713. NOMCHE(1)='SCAL'
  714. TYPCHE(1)='REAL*8'
  715. N2PTEL=0
  716. N2EL=0
  717. SEGINI MELVAL
  718. IELVAL(1)=MELVAL
  719. IMELCR=MELVAL
  720. C
  721. C MISE A 0 DES VARIABLES DU COMMON NECOU SI BESOIN
  722. C LES BONNES VALEURS SONT ATTRIBUEES SELON LES MODELES
  723. C INITIALISATIONS SELON LES CAS
  724. C
  725. LTRAC=0
  726. IF(INPLAS.NE.2)THEN
  727. IFOURB=IFOUR
  728. NCOURB=0
  729. IPLAST=0
  730. IMAPLA=1
  731. IT=1
  732. ISOTRO=0
  733. ITYP=0
  734. C
  735. C CORRESPONDANCE ( MFR,IFOUR) ET ITYP FAITE DANS ECOCRI
  736. C
  737. IFLUAG=0
  738. ICINE=0
  739. ITHER=0
  740. IFLUPL=0
  741. ICYCL=0
  742. IBI=0
  743. JFLUAG=0
  744. KFLUAG=0
  745. LFLUAG=0
  746. IRELAX=0
  747. JNTRIN=0
  748. MFLUAG=0
  749. JSOUFL=0
  750. JGRDEF=0
  751. LTRAC=60
  752. ENDIF
  753. *
  754. * INITIALISATION DES SEGMENTS DE TRAVAIL
  755. *
  756. NCXMAT=NMATT
  757. IF(INPLAS.EQ.3)NCXMAT=NMATT+7
  758. SEGINI WRK0,WRK1,WRK2,WRK3
  759. IF(MFR.EQ.7.OR.MFR.EQ.13)THEN
  760. NBBB=NBNN
  761. SEGINI WRK4
  762. ENDIF
  763. *
  764. * BOUCLE SUR LES ELEMENTS
  765. *
  766. DO 200 IB=1,NBELEM
  767. *
  768. * BOUCLE SUR LES POINTS DE GAUSS
  769. *
  770. DO 300 IGAU=1,NBPTEL
  771. *
  772. * ON RECUPERE LES CONTRAINTES
  773. *
  774. MPTVAL=IVASTR
  775. DO 201 IC=1,NSTRS
  776. MELVAL=IVAL(IC)
  777. IBMN=MIN(IB,VELCHE(/2))
  778. IGMN=MIN(IGAU,VELCHE(/1))
  779. SIG0(IC)=VELCHE(IGMN,IBMN)
  780. 201 CONTINUE
  781. *
  782. * ON RECUPERE LES VARIABLES INTERNES
  783. *
  784. MPTVAL=IVARI
  785. DO 202 IC=1,NVARI
  786. MELVAL=IVAL(IC)
  787. IBMN=MIN(IB,VELCHE(/2))
  788. IGMN=MIN(IGAU,VELCHE(/1))
  789. VAR0(IC)=VELCHE(IGMN,IBMN)
  790. 202 CONTINUE
  791. *
  792. * ON RECUPERE LES CONSTANTES DU MATERIAU
  793. *
  794. MPTVAL=IVAMAT
  795. IF(INPLAS.EQ.9 .OR.INPLAS .EQ. 28)THEN
  796. *
  797. * POUR LE MODELE BETON ET UBIQUITOUS
  798. *
  799. DO 203 IC=1,NMATT
  800. MELVAL=IVAL(IC)
  801. IF(MELVAL.NE.0)THEN
  802. IBMN=MIN(IB,VELCHE(/2))
  803. IGMN=MIN(IGAU,VELCHE(/1))
  804. XMAT(IC)=VELCHE(IGMN,IBMN)
  805. ELSE
  806. XMAT(IC)=0.D0
  807. ENDIF
  808. 203 CONTINUE
  809. ELSE
  810. *
  811. * POUR LES AUTRES MODELES
  812. *
  813. MELVAL=IVAL(1)
  814. IF(MELVAL.NE.0)THEN
  815. IF(TYVAL(1)(1:8).NE.'POINTEUR')THEN
  816. IBMN=MIN(IB,VELCHE(/2))
  817. IGMN=MIN(IGAU,VELCHE(/1))
  818. XMAT(1)=VELCHE(IGMN,IBMN)
  819. ELSE
  820. IBMN=MIN(IB,IELCHE(/2))
  821. IGMN=MIN(IGAU,IELCHE(/1))
  822. XMAT(1)=IELCHE(IGMN,IBMN)
  823. ENDIF
  824. ELSE
  825. XMAT(1)=0.D0
  826. IF(TYVAL(1)(1:8).EQ.'POINTEUR') THEN
  827. XMAT(1)=0
  828. END IF
  829. ENDIF
  830. MELVAL=IVAL(2)
  831. IF(MELVAL.NE.0)THEN
  832. IF(TYVAL(2)(1:8).NE.'POINTEUR')THEN
  833. IBMN=MIN(IB,VELCHE(/2))
  834. IGMN=MIN(IGAU,VELCHE(/1))
  835. XMAT(2)=VELCHE(IGMN,IBMN)
  836. ELSE
  837. IBMN=MIN(IB,IELCHE(/2))
  838. IGMN=MIN(IGAU,IELCHE(/1))
  839. XMAT(2)=IELCHE(IGMN,IBMN)
  840. ENDIF
  841. ELSE
  842. XMAT(2)=0.D0
  843. IF(TYVAL(2)(1:8).EQ.'POINTEUR') THEN
  844. XMAT(2)=0
  845. END IF
  846. ENDIF
  847. DO 205 IC=3,NMATT-2
  848. MELVAL=IVAL(IC)
  849. IF(MELVAL.NE.0)THEN
  850. IF(TYVAL(IC)(1:8).NE.'POINTEUR')THEN
  851. IBMN=MIN(IB,VELCHE(/2))
  852. IGMN=MIN(IGAU,VELCHE(/1))
  853. XMAT(IC+2)=VELCHE(IGMN,IBMN)
  854. ELSE
  855. IBMN=MIN(IB,IELCHE(/2))
  856. IGMN=MIN(IGAU,IELCHE(/1))
  857. XMAT(IC+2)=IELCHE(IGMN,IBMN)
  858. ENDIF
  859. ELSE
  860. XMAT(IC+2)=0.D0
  861. IF(TYVAL(IC)(1:8).EQ.'POINTEUR') THEN
  862. XMAT(IC+2)=0
  863. END IF
  864. ENDIF
  865. 205 CONTINUE
  866. MELVAL=IVAL(NMATT-1)
  867. IF(MELVAL.NE.0)THEN
  868. IF(TYVAL(NMATT-1)(1:8).NE.'POINTEUR')THEN
  869. IBMN=MIN(IB,VELCHE(/2))
  870. IGMN=MIN(IGAU,VELCHE(/1))
  871. XMAT(3)=VELCHE(IGMN,IBMN)
  872. ELSE
  873. IBMN=MIN(IB,IELCHE(/2))
  874. IGMN=MIN(IGAU,IELCHE(/1))
  875. XMAT(3)=IELCHE(IGMN,IBMN)
  876. ENDIF
  877. ELSE
  878. XMAT(3)=0.D0
  879. IF(TYVAL(NMATT-1)(1:8).EQ.'POINTEUR')XMAT(3)=0
  880. END IF
  881. MELVAL=IVAL(NMATT)
  882. IF(MELVAL.NE.0)THEN
  883. IF(TYVAL(NMATT)(1:8).NE.'POINTEUR')THEN
  884. IBMN=MIN(IB,VELCHE(/2))
  885. IGMN=MIN(IGAU,VELCHE(/1))
  886. XMAT(4)=VELCHE(IGMN,IBMN)
  887. ELSE
  888. IBMN=MIN(IB,IELCHE(/2))
  889. IGMN=MIN(IGAU,IELCHE(/1))
  890. XMAT(4)=IELCHE(IGMN,IBMN)
  891. ENDIF
  892. ELSE
  893. XMAT(4)=0.D0
  894. IF(TYVAL(NMATT)(1:8).EQ.'POINTEUR') THEN
  895. XMAT(4)=0
  896. END IF
  897. ENDIF
  898. *
  899. * REARRANGEMENT POUR CERTAINES LOIS
  900. *
  901. IF (INPLAS.EQ.14) THEN
  902. IF(XMAT(8).NE.XZER.OR.XMAT(9).NE.XZER)THEN
  903. INPLAS=18
  904. XMAT(5)=XMAT(8)
  905. XMAT(6)=XMAT(9)
  906. ENDIF
  907. ELSE IF (INPLAS.EQ.2) THEN
  908. IF (XMAT(6).NE.XZER) THEN
  909. INPLAS=27
  910. XMAT(5)=XMAT(6)
  911. ENDIF
  912. ELSE IF (INPLAS.EQ.29)THEN
  913. YXMAT=XMAT(13)
  914. XMAT(13)=XMAT(4)
  915. XMAT(4)=XMAT(3)
  916. XMAT(3)=YXMAT
  917. ENDIF
  918. ENDIF
  919. *
  920. * ON RECUPERE LES CARACTERISTIQUES GEOMETRIQUES
  921. *
  922. IF(IVACAR.NE.0)THEN
  923. MPTVAL=IVACAR
  924. *
  925. * cas des tuyaux
  926. *
  927. IF(MFR.EQ.13)THEN
  928. DO 106 IC=1,5
  929. MELVAL=IVAL(IC)
  930. IF(MELVAL.NE.0)THEN
  931. IBMN=MIN(IB,VELCHE(/2))
  932. IGMN=MIN(IGAU,VELCHE(/1))
  933. XCAR(IC)=VELCHE(IGMN,IBMN)
  934. ELSE
  935. XCAR(IC)=0.D0
  936. ENDIF
  937. 106 CONTINUE
  938. IF(IVECT.EQ.1)THEN
  939. DO 107 IC=6,NCARR-1
  940. MELVAL=IVAL(IC)
  941. IF(MELVAL.NE.0)THEN
  942. IBMN=MIN(IB,VELCHE(/2))
  943. IGMN=MIN(IGAU,VELCHE(/1))
  944. XCAR(IC)=VELCHE(IGMN,IBMN)
  945. ELSE
  946. XCAR(IC)=-1.D0
  947. ENDIF
  948. 107 CONTINUE
  949. IF(IVAL(NCARR).NE.0)THEN
  950. MELVAL=IVAL(NCARR)
  951. IBMN=MIN(IB,IELCHE(/2))
  952. IGMN=MIN(IGAU,IELCHE(/1))
  953. IP=IELCHE(IGMN,IBMN)
  954. IREF=(IP-1)*(IDIM+1)
  955. DO 108 IC=1,IDIM
  956. XCAR(NCARR+IC-1)=XCOOR(IREF+IC)
  957. 108 CONTINUE
  958. ELSE
  959. DO 109 IC=1,IDIM
  960. XCAR(NCARR+IC-1)=0.D0
  961. 109 CONTINUE
  962. ENDIF
  963. ELSE
  964. DO 110 IC=6,10
  965. MELVAL=IVAL(IC)
  966. IF(MELVAL.NE.0)THEN
  967. IBMN=MIN(IB,VELCHE(/2))
  968. IGMN=MIN(IGAU,VELCHE(/1))
  969. XCAR(IC)=VELCHE(IGMN,IBMN)
  970. ELSE
  971. XCAR(IC)=-1.D0
  972. ENDIF
  973. 110 CONTINUE
  974. DO 111 IC=11,ICARA
  975. MELVAL=IVAL(IC)
  976. IF(MELVAL.NE.0)THEN
  977. IBMN=MIN(IB,VELCHE(/2))
  978. IGMN=MIN(IGAU,VELCHE(/1))
  979. XCAR(IC)=VELCHE(IGMN,IBMN)
  980. ELSE
  981. XCAR(IC)=0.D0
  982. ENDIF
  983. 111 CONTINUE
  984. ENDIF
  985. ELSE IF(MFR.EQ.7.AND.IVECT.EQ.1)THEN
  986. DO 206 IC=1,NCARR-1
  987. MELVAL=IVAL(IC)
  988. IF(MELVAL.NE.0)THEN
  989. IBMN=MIN(IB,VELCHE(/2))
  990. IGMN=MIN(IGAU,VELCHE(/1))
  991. XCAR(IC)=VELCHE(IGMN,IBMN)
  992. ELSE
  993. XCAR(IC)=0.D0
  994. ENDIF
  995. 206 CONTINUE
  996. IF(IVAL(NCARR).NE.0)THEN
  997. MELVAL=IVAL(NCARR)
  998. IBMN=MIN(IB,IELCHE(/2))
  999. IGMN=MIN(IGAU,IELCHE(/1))
  1000. IP=IELCHE(IGMN,IBMN)
  1001. IREF=(IP-1)*(IDIM+1)
  1002. DO 207 IC=1,IDIM
  1003. XCAR(NCARR+IC-1)=XCOOR(IREF+IC)
  1004. 207 CONTINUE
  1005. ELSE
  1006. DO 208 IC=1,IDIM
  1007. XCAR(NCARR+IC-1)=0.D0
  1008. 208 CONTINUE
  1009. ENDIF
  1010. ELSE
  1011. DO 209 IC=1,ICARA
  1012. MELVAL=IVAL(IC)
  1013. IF(MELVAL.NE.0)THEN
  1014. IBMN=MIN(IB,VELCHE(/2))
  1015. IGMN=MIN(IGAU,VELCHE(/1))
  1016. XCAR(IC)=VELCHE(IGMN,IBMN)
  1017. ELSE
  1018. XCAR(IC)=0.D0
  1019. ENDIF
  1020. 209 CONTINUE
  1021. ENDIF
  1022. *
  1023. * REARRANGEMENT DU TABLEAU XCAR POUR QU'ON AI LA MEME ORDRE
  1024. * QUE L'ANCIEN CHAMELEM
  1025. *
  1026. IF(MFR.EQ.7)THEN
  1027. IF(IDIM.EQ.2)THEN
  1028. VX=XCAR(ICARA-3)
  1029. VY=XCAR(ICARA-2)
  1030. XCAR(ICARA-3)=XCAR(ICARA-1)
  1031. XCAR(ICARA-2)=XCAR(ICARA)
  1032. XCAR(ICARA-1)=VX
  1033. XCAR(ICARA)=VY
  1034. ELSEIF(IDIM.EQ.3)THEN
  1035. VX=XCAR(ICARA-5)
  1036. VY=XCAR(ICARA-4)
  1037. VZ=XCAR(ICARA-3)
  1038. XCAR(ICARA-5)=XCAR(ICARA-2)
  1039. XCAR(ICARA-4)=XCAR(ICARA-1)
  1040. XCAR(ICARA-3)=XCAR(ICARA)
  1041. XCAR(ICARA-2)=VX
  1042. XCAR(ICARA-1)=VY
  1043. XCAR(ICARA)=VZ
  1044. ENDIF
  1045. ELSE IF(MFR.EQ.13)THEN
  1046. NWORK2 = 7
  1047. DO 210 IC=4,10
  1048. WORK2(IC-3)=XCAR(IC)
  1049. 210 CONTINUE
  1050. IF(IDIM.EQ.2)THEN
  1051. XCAR(4)=XCAR(ICARA-1)
  1052. XCAR(5)=XCAR(ICARA)
  1053. DO 211 IC=1,NWORK2
  1054. XCAR(IC+5)=WORK2(IC)
  1055. 211 CONTINUE
  1056. ELSE IF(IDIM.EQ.3)THEN
  1057. XCAR(4)=XCAR(ICARA-2)
  1058. XCAR(5)=XCAR(ICARA-1)
  1059. XCAR(6)=XCAR(ICARA)
  1060. DO 212 IC=1,NWORK2
  1061. XCAR(IC+6)=WORK2(IC)
  1062. 212 CONTINUE
  1063. ENDIF
  1064. ENDIF
  1065. ENDIF
  1066. *
  1067. IF(INPLAS.EQ.0) THEN
  1068. CRITER = 0.D0
  1069. GOTO 510
  1070. C
  1071. ELSE
  1072. C=======================================================================
  1073. C NUMERO DES ETIQUETTES :
  1074. C
  1075. C 1 A 99 POUR LES MODELES DE PLASTICITE ( INDICE INPLAS )
  1076. C
  1077. C=======================================================================
  1078. GOTO (1, 2, 3, 4, 5,99, 7,99,99,99, 7, 7, 7,14,15,99,99,99,99,99,
  1079. . 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  1080. . 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  1081. . 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99),INPLAS
  1082. C
  1083. 99 CONTINUE
  1084. KERRE=999
  1085. MOTERR(1:4)=NOMAC(INPLAS)
  1086. MOTERR(5:12)=NOMFR(MFR)
  1087. CALL ERREUR(269)
  1088. SEGSUP WRK0,WRK1,WRK2,WRK3
  1089. IF(MFR.EQ.7.OR.MFR.EQ.13)SEGSUP WRK4
  1090. GOTO 9990
  1091. C
  1092. C MODELE VON MISES ISOTROPE ASSOCIE ( D'APRES INCA )
  1093. C
  1094. 1 CONTINUE
  1095. C
  1096. C CAS DE LA PLASTICITE PARFAITE
  1097. C
  1098. NCOURB=2
  1099. TRAC(1)=XMAT(5)
  1100. TRAC(2)=0.D0
  1101. TRAC(3)=XMAT(5)
  1102. TRAC(4)=1.D0
  1103. IF(XMAT(5).EQ.XZER) THEN
  1104. KERRE=33
  1105. GO TO 510
  1106. ENDIF
  1107. GOTO 682
  1108. C
  1109. 3 CONTINUE
  1110. C
  1111. C CAS DU MODELE DE DRUCKER-PRAGER PARFAIT
  1112. C LES DONNEES SONT LES LIMITES EN TRACTION ET EN COMPRESSION
  1113. C
  1114. IMAPLA=5
  1115. DEN = ABS(XMAT(6)) + XMAT(5)
  1116. IF(DEN.EQ.0.D0) THEN
  1117. KERRE=48
  1118. GO TO 510
  1119. ENDIF
  1120. XMAT(7) = 2.0D0*ABS(XMAT(6))*XMAT(5)/DEN
  1121. XMAT(5) = (ABS(XMAT(6)) - XMAT(5))/DEN
  1122. XMAT(6) = SQRT(3.D0)
  1123. XMAT(8)=XMAT(5)
  1124. XMAT(9)=XMAT(6)
  1125. XMAT(10)=XMAT(5)
  1126. XMAT(11)=XMAT(6)
  1127. XMAT(12)=XMAT(7)
  1128. XMAT(13)=0.D0
  1129. C PETITS TESTS SUR LES DONNEES
  1130. IF(XMAT(10)/(XMAT(11)+1.D-20).GT.XMAT(5)*1.01/(XMAT(6)+1.D-20)
  1131. . .OR.XMAT(12).GT.XMAT(7)*1.01 ) THEN
  1132. KERRE=48
  1133. GO TO 510
  1134. ENDIF
  1135. GOTO 682
  1136. C
  1137. 4 CONTINUE
  1138. C
  1139. C CAS DE LA PLASTICITE CINEMATIQUE BILINEAIRE
  1140. C
  1141. ICINE=1
  1142. NCOURB=2
  1143. TRAC(1)=XMAT(5)
  1144. TRAC(2)=0.D0
  1145. TRAC(3)=XMAT(5)+XMAT(6)
  1146. TRAC(4)=1.D0
  1147. IF(XMAT(5).EQ.0.D0) THEN
  1148. KERRE=33
  1149. GO TO 510
  1150. ENDIF
  1151. GOTO 682
  1152. C
  1153. 5 CONTINUE
  1154. C
  1155. C CAS DE LA PLASTICITE ISOTROPE ECROUISSABLE
  1156. C
  1157. C ON RECUPERE LA COURBE DE TRACTION
  1158. C
  1159. nccor=ncourb
  1160. CALL COTRAC(WRK0,WRK2,NCcor,KERRE)
  1161. ncourb=nccor
  1162. IF(KERRE.NE.0) GO TO 510
  1163. GO TO 682
  1164. C
  1165. 7 CONTINUE
  1166. C
  1167. C CAS DU MODELE CHABOCHE
  1168. C
  1169. ICINE=1
  1170. IMAPLA=4
  1171. GOTO 682
  1172. C
  1173. 15 CONTINUE
  1174. C
  1175. C CAS DU MODELE DE DRUCKER-PRAGER GENERAL
  1176. C
  1177. IMAPLA=5
  1178. C PAS D'INITIALISATIONS PAR DEFAUT POUR LE MOMENT
  1179. C IF(XMAT(8).EQ.0.) XMAT(8)=XMAT(5)
  1180. C IF(XMAT(9).EQ.0.) XMAT(9)=XMAT(6)
  1181. C IF(XMAT(10).EQ.0.) XMAT(10)=XMAT(5)
  1182. C IF(XMAT(11).EQ.0.) XMAT(11)=XMAT(6)
  1183. C IF(XMAT(12).EQ.0.) XMAT(12)=XMAT(7)
  1184. C PETITS TESTS SUR LES DONNEES
  1185. IF(XMAT(10)/(XMAT(11)+1.D-20).GT.XMAT(5)*1.01/(XMAT(6)+1.D-20)
  1186. . .OR.XMAT(12).GT.XMAT(7)*1.01 ) THEN
  1187. KERRE=48
  1188. GO TO 510
  1189. ENDIF
  1190. C PERMUTATIONS POUR ECOCRI
  1191. DO 615 I=5,7
  1192. WW=XMAT(I)
  1193. XMAT(I)=XMAT(I+5)
  1194. 615 XMAT(I+5)=WW
  1195. GOTO 682
  1196. C
  1197. 682 CONTINUE
  1198. DO 675 IC=1,ICARA
  1199. 675 WORK(IC)=XCAR(IC)
  1200. BID(1)=0.D00
  1201. BID(2)=0.D00
  1202. BID(3)=0.D00
  1203. necobi=necou
  1204. neecbi=ecou
  1205. CALL ECOCRI(SIG0,VAR0,BID,XMAT,CRITER,WORK ,
  1206. . TRAC,KERRE,MFR,NSTRS,INPLAS,necou,ecou)
  1207. IF(KERRE.EQ.99) GO TO 99
  1208. GOTO 510
  1209. C
  1210. C MODELE LINESPRING
  1211. C
  1212. 2 CONTINUE
  1213. CALL LISCRI(SIG0,XMAT,XCAR,KERRE,CRITER)
  1214. GOTO 510
  1215. C
  1216. C TUYAU FISSURE
  1217. C
  1218. 14 CONTINUE
  1219. CALL TUFCRI(SIG0,VAR0,XMAT,XCAR,KERRE,CRITER)
  1220. GOTO 510
  1221. ENDIF
  1222. C
  1223. 510 CONTINUE
  1224. IF(KERRE.NE.0) THEN
  1225. C
  1226. C IMPRESSION DE QUELQUES MESSAGES D ERREURS
  1227. C
  1228. INTERR(1)=IB
  1229. INTERR(2)=IGAU
  1230. MOTERR(1:4)=NOMTP(MELE)
  1231. IF(KERRE.EQ.1) CALL ERREUR(267)
  1232. IF(KERRE.EQ.2) CALL ERREUR(268)
  1233. IF(KERRE.EQ.7) CALL ERREUR(355)
  1234. IF(KERRE.EQ.30) CALL ERREUR(270)
  1235. IF(KERRE.EQ.31) CALL ERREUR(271)
  1236. IF(KERRE.EQ.32) CALL ERREUR(272)
  1237. IF(KERRE.EQ.33) CALL ERREUR(273)
  1238. IF(KERRE.EQ.34) CALL ERREUR(325)
  1239. IF(KERRE.EQ.35) CALL ERREUR(331)
  1240. IF(KERRE.EQ.36) CALL ERREUR(330)
  1241. IF(KERRE.EQ.37) CALL ERREUR(354)
  1242. IF(KERRE.EQ.38) CALL ERREUR(360)
  1243. IF(KERRE.EQ.48) CALL ERREUR(366)
  1244. IF(KERRE.EQ.75) CALL ERREUR(876)
  1245. SEGSUP WRK0,WRK1,WRK2,WRK3
  1246. IF(MFR.EQ.7.OR.MFR.EQ.13)SEGSUP WRK4
  1247. GO TO 9990
  1248. ENDIF
  1249. C
  1250. C REMPLISSAGE DU SEGMENT
  1251. C
  1252. MELVAL=IMELCR
  1253. VELCHE(IGAU,IB)=CRITER
  1254. C
  1255. 300 CONTINUE
  1256. 200 CONTINUE
  1257. SEGSUP WRK0,WRK1,WRK2,WRK3
  1258. IF(MFR.EQ.7.OR.MFR.EQ.13)SEGSUP WRK4
  1259. 9990 CONTINUE
  1260. *
  1261. * DESACTIVATION DES SEGMENTS
  1262. *
  1263. SEGDES MELEME,IMODEL
  1264. SEGDES,MINTE
  1265. *
  1266. IF(ISUP1.EQ.1)THEN
  1267. CALL DTMVAL (IVASTR,3)
  1268. ELSE
  1269. CALL DTMVAL (IVASTR,1)
  1270. ENDIF
  1271. IF(ISUP2.EQ.1)THEN
  1272. CALL DTMVAL (IVARI,3)
  1273. ELSE
  1274. CALL DTMVAL (IVARI,1)
  1275. ENDIF
  1276. IF(ISUP3.EQ.1)THEN
  1277. CALL DTMVAL (IVAMAT,3)
  1278. ELSE
  1279. CALL DTMVAL (IVAMAT,1)
  1280. ENDIF
  1281. IF(ISUP3.EQ.1)THEN
  1282. CALL DTMVAL (IVACAR,3)
  1283. ELSE
  1284. CALL DTMVAL (IVACAR,1)
  1285. ENDIF
  1286. *
  1287. IF (MOCARA.NE.0) THEN
  1288. NOMID=MOCARA
  1289. SEGSUP NOMID
  1290. END IF
  1291. *
  1292. IF (MOMATR.NE.0) THEN
  1293. NOMID=MOMATR
  1294. if(lsupma)SEGSUP NOMID
  1295. END IF
  1296. *
  1297. IF (MOVARI.NE.0) THEN
  1298. NOMID=MOVARI
  1299. if(lsupva)SEGSUP NOMID
  1300. END IF
  1301. *
  1302. IF (MOSTRS.NE.0) THEN
  1303. NOMID=MOSTRS
  1304. if(lsupco)SEGSUP NOMID
  1305. END IF
  1306. *
  1307. segsup necou,ecou
  1308. IF(KERRE.EQ.0)THEN
  1309. MELVAL=IMELCR
  1310. SEGDES MELVAL
  1311. SEGDES MCHAML
  1312. ELSE
  1313. MELVAL=IMELCR
  1314. SEGSUP MELVAL
  1315. SEGSUP MCHAML
  1316. GO TO 888
  1317. ENDIF
  1318. 500 CONTINUE
  1319. *
  1320. 888 CONTINUE
  1321. SEGDES MMODEL
  1322. IF(KERRE.EQ.0)THEN
  1323. SEGDES MCHELM
  1324. ELSE
  1325. SEGSUP MCHELM
  1326. ENDIF
  1327. *
  1328. RETURN
  1329. END
  1330.  
  1331.  
  1332.  
  1333.  
  1334.  
  1335.  
  1336.  

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