Télécharger motana.eso

Retour à la liste

Numérotation des lignes :

  1. C MOTANA SOURCE AM 16/04/12 21:16:34 8903
  2. SUBROUTINE MOTANA(IPMODL,IPCHE1,IPCHE2,IPCHE3,PRECIS,IPSCAL,IRET)
  3. *______________________________________________________________________
  4. *
  5. *
  6. *
  7. * ENTREES :
  8. * ---------
  9. * IPMODL pointeur sur un MMODEL
  10. * IPCHE1 pointeur sur un MCHAML de sous type CONTRAINTES
  11. * IPCHE2 pointeur sur un MCHAML de sous type VARIABLES INTERNES
  12. * IPCHE3 pointeur sur le MCHAML de sous type CARACTARISTIQUE
  13. * PRECIS flottant
  14. *
  15. * SORTIES :
  16. * ---------
  17. * IPSCAL pointeur sur l'objet de type RIGIDITE
  18. * IRET = 1 si succes 0 sinon
  19. *
  20. * passage aux nouveaux CHAMELEMs par JM CAMPENON LE 06/91
  21. *
  22. *______________________________________________________________________
  23. *
  24. IMPLICIT INTEGER(I-N)
  25. IMPLICIT REAL*8(A-H,O-Z)
  26. *
  27. -INC PPARAM
  28. -INC CCOPTIO
  29. -INC CCHAMP
  30. -INC SMINTE
  31. -INC SMMODEL
  32. -INC SMELEME
  33. -INC SMCHAML
  34. -INC SMCOORD
  35. -INC SMLREEL
  36. -INC SMEVOLL
  37. *______________________________________________________________________
  38. *
  39. * LA VARIABLE KERRE REGIT LES IMPRESSIONS D ERREURS DANS MOTAN
  40. * TOUTES ERREURS DE PLASTICITE GEREES DANS CE SOUS PROGRAMME
  41. * KERRE=0 TOUT OK
  42. * DE 1 A 7 S ALIGNER SUR VALEURS DONNEES PAR ECOINC
  43. * = 21 ON NE TROUVE PAS D INTERSECTION AVEC LA SURFACE DE CHARGE
  44. * = 22 SIG0 A L EXTERIEUR DE LA SURFACE DE CHARGE
  45. *
  46. * = 30 31 32 ANOMALIES AVEC LA COURBE DE TRACTION
  47. * = 33 LIMITE ELASTIQUE NULLE
  48. * = 99 CAS NON ENCORE DISPONIBLE
  49. *----------------------------------------------------------------------
  50. *
  51. SEGMENT WRK0
  52. REAL*8 XMAT(NCXMAT)
  53. ENDSEGMENT
  54. *
  55. SEGMENT WRK1
  56. REAL*8 DDHOOK(NSTRS,NSTRS),SIG0(NSTRS),
  57. . DSIGT(NSTRS),SIGF(NSTRS),VAR0(NVARI),
  58. . VARF(NVARI),DEFP(NSTRS),XCAR(ICARA)
  59. ENDSEGMENT
  60. *
  61. SEGMENT WRK2
  62. REAL*8 TRAC(LTRAC)
  63. ENDSEGMENT
  64. *
  65. SEGMENT WRK3
  66. REAL*8 WORK(LW)
  67. ENDSEGMENT
  68. *
  69. SEGMENT WRK4
  70. REAL *8 XE(3,NBBB)
  71. ENDSEGMENT
  72. *
  73. SEGMENT WRK5
  74. REAL*8 SIG(LSIG),EPS(LSIG)
  75. ENDSEGMENT
  76. *
  77. SEGMENT WRK6
  78. REAL*8 COVNMS(6)
  79. ENDSEGMENT
  80. *
  81. SEGMENT MPTVAL
  82. INTEGER IPOS(NS) ,NSOF(NS)
  83. INTEGER IVAL(NCOSOU)
  84. CHARACTER*16 TYVAL(NCOSOU)
  85. ENDSEGMENT
  86. *
  87. SEGMENT NOTYPE
  88. CHARACTER*16 TYPE(NBTYPE)
  89. ENDSEGMENT
  90. *
  91. CHARACTER*8 CMATE
  92. CHARACTER*(NCONCH) CONM
  93. PARAMETER ( NINF=3 )
  94. INTEGER INFOS(NINF)
  95. LOGICAL lsupva,lsupco
  96. *
  97. DIMENSION XEPOU(2),YEPOU(2),ZEPOU(2),DIV(7)
  98. DATA PI4,R33,R22/0.785398164D0,1.732050808D0,1.414213562D0/
  99.  
  100. IRET = 0
  101. NHRM=NIFOUR
  102. *
  103. * Verification du lieu support du MCHAML de contraintes
  104. *
  105. CALL QUESUP(IPMODL,IPCHE1,3,0,ISUPCO,IRETCO)
  106. IF (ISUPCO.GT.1) RETURN
  107. *
  108. * Verification du lieu support du MCHAML de variables internes
  109. *
  110. CALL QUESUP(IPMODL,IPCHE2,3,0,ISUPVA,IRETVA)
  111. IF (ISUPVA.GT.1) RETURN
  112. *
  113. * Verification du lieu support du MCHAML de materiau
  114. *
  115. CALL QUESUP(IPMODL,IPCHE3,3,0,ISUPMA,IRETMA)
  116. IF (ISUPMA.GT.1) RETURN
  117. *
  118. * Activation du MMODEL
  119. *
  120. MMODEL=IPMODL
  121. SEGACT MMODEL
  122. NSOUS=KMODEL(/1)
  123. *
  124. * Creation du MCHELM
  125. *
  126. N1=NSOUS
  127. L1=8
  128. N3=6
  129. SEGINI MCHELM
  130. TITCHE='SCALAIRE'
  131. IFOCHE=IFOUR
  132. IPSCAL=MCHELM
  133. *
  134. DO 500 ISOUS=1,NSOUS
  135. *
  136. * INITIALISATION
  137. *
  138. NSTR=0
  139. IVACON=0
  140. MOVARI=0
  141. NVARI=0
  142. IVAVAR=0
  143. NCARA=0
  144. NCARF=0
  145. MOCARA=0
  146. IVACAR=0
  147. NMATF=0
  148. NMATR=0
  149. MOMATR=0
  150. IVAMAT=0
  151. KERRE=0
  152. *
  153. IMODEL=KMODEL(ISOUS)
  154. IPMOD1=IMODEL
  155. SEGACT IMODEL
  156. IPMAIL=IMAMOD
  157. CONM =CONMOD
  158. C
  159. C COQUE INTEGREE OU PAS ?
  160. C
  161. IF(INFMOD(/1).NE.0)THEN
  162. NPINT=INFMOD(1)
  163. ELSE
  164. NPINT=0
  165. ENDIF
  166. IF (NPINT.NE.0)THEN
  167. CALL ERREUR(615)
  168. SEGDES IMODEL,MMODEL
  169. SEGSUP MCHELM
  170. RETURN
  171. ENDIF
  172. C
  173. IMACHE(ISOUS)=IPMAIL
  174. CONCHE(ISOUS)=CONMOD
  175. *
  176. MELE=NEFMOD
  177. MELEME=IMAMOD
  178. *
  179. * Nature du materiau
  180. *
  181. NFOR=FORMOD(/2)
  182. NMAT=MATMOD(/2)
  183. CALL NOMATE (FORMOD,NFOR,MATMOD,NMAT,CMATE,INELAS,INPLAS)
  184. IF (CMATE.EQ.' '.OR.CMATE.NE.'ISOTROPE') THEN
  185. CALL ERREUR(251)
  186. GOTO 9900
  187. ENDIF
  188. *
  189. * Information sur l'element fini
  190. *
  191. * CALL ELQUOI(MELE,0,3,IPINF,IMODEL)
  192. * IF (IERR.NE.0) GOTO 9900
  193. * INFO =IPINF
  194. MFR =INFELE(13)
  195. NBG =INFELE(6)
  196. NBGS =INFELE(4)
  197. NSTRS=INFELE(16)
  198. LW =200
  199. LHOOK=INFELE(10)
  200. * MINTE=INFELE(11)
  201. minte=infmod(5)
  202. IPMIN1=MINTE
  203. *
  204. INFCHE(ISOUS,1)=0
  205. INFCHE(ISOUS,2)=0
  206. INFCHE(ISOUS,3)=NHRM
  207. INFCHE(ISOUS,4)=MINTE
  208. INFCHE(ISOUS,5)=0
  209. INFCHE(ISOUS,6)=3
  210. *
  211. SEGACT MINTE
  212. NBPGAU=POIGAU(/1)
  213. NBNO =SHPTOT(/2)
  214. *
  215. SEGACT MELEME
  216. NBNN =NUM(/1)
  217. NBELEM=NUM(/2)
  218. IPPORE=0
  219. IF(MFR.EQ.33) IPPORE=NBNN
  220.  
  221. * INFO=IPINF
  222. * SEGSUP INFO
  223. *
  224. * Creation du tableau INFOS
  225. *
  226. CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  227. IF (IRTD.EQ.0) GOTO 9901
  228. *
  229. * Verification du MCHAML de contraintes
  230. *
  231. if(lnomid(4).ne.0) then
  232. nomid=lnomid(4)
  233. segact nomid
  234. mocont=nomid
  235. nstr=lesobl(/2)
  236. nfac=lesfac(/2)
  237. lsupco=.false.
  238. else
  239. lsupco=.true.
  240. CALL IDCONT(IMODEL,IFOUR,MOCONT,NSTR,NFAC)
  241. endif
  242. *
  243. NBTYPE=1
  244. SEGINI NOTYPE
  245. TYPE(1)='REAL*8'
  246. MOTYPE=NOTYPE
  247. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCONT,MOTYPE,
  248. . 1,INFOS,3,IVACON)
  249. SEGSUP NOTYPE
  250. IF (IERR.NE.0) GOTO 9910
  251. *
  252. IF (ISUPCO.EQ.1) THEN
  253. CALL VALCHE(IVACON,NSTRS,IPMIN1,IPPORE,MOCONT,MELE)
  254. ENDIF
  255. *
  256. * Verification du MCHAML de variables internes
  257. *
  258. if(lnomid(10).ne.0) then
  259. nomid=lnomid(10)
  260. segact nomid
  261. movari=nomid
  262. nvari=lesobl(/2)
  263. nfac=lesfac(/2)
  264. lsupva=.false.
  265. else
  266. lsupva=.true.
  267. CALL IDVARI(MFR,IPMOD1,MOVARI,NVARI,NFAC)
  268. endif
  269. *
  270. NBTYPE=1
  271. SEGINI NOTYPE
  272. TYPE(1)='REAL*8'
  273. MOTYPE=NOTYPE
  274. CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOVARI,MOTYPE,
  275. . 1,INFOS,3,IVAVAR)
  276. SEGSUP NOTYPE
  277. IF(IERR.NE.0)GOTO 9920
  278. *
  279. IF (ISUPVA.EQ.1) THEN
  280. CALL VALCHE(IVAVAR,NVARI,IPMIN1,IPPORE,MOVARI,MELE)
  281. ENDIF
  282. *
  283. * Creation du tableau INFOS
  284. *
  285. CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE3,INFOS,IRTD)
  286. IF (IRTD.EQ.0) GOTO 9920
  287. *
  288. * Verification du MCHAML de materiau
  289. *
  290. NBROBL=0
  291. NBRFAC=0
  292. MOMATR=0
  293. *
  294. IF (INPLAS.EQ.1) THEN
  295. NBROBL=2
  296. SEGINI NOMID
  297. MOMATR=NOMID
  298. LESOBL(1)='YOUN'
  299. LESOBL(2)='SIGY'
  300. *
  301. NBTYPE=1
  302. SEGINI NOTYPE
  303. MOTYPE=NOTYPE
  304. TYPE(1)='REAL*8'
  305. ELSE IF (INPLAS.EQ.4) THEN
  306. NBROBL=3
  307. SEGINI NOMID
  308. MOMATR=NOMID
  309. LESOBL(1)='YOUN'
  310. LESOBL(2)='SIGY'
  311. LESOBL(3)='H '
  312. *
  313. NBTYPE=1
  314. SEGINI NOTYPE
  315. MOTYPE=NOTYPE
  316. TYPE(1)='REAL*8'
  317. ELSE IF (INPLAS.EQ.5) THEN
  318. NBROBL=2
  319. SEGINI NOMID
  320. MOMATR=NOMID
  321. LESOBL(1)='YOUN'
  322. LESOBL(2)='TRAC'
  323. *
  324. NBTYPE=2
  325. SEGINI NOTYPE
  326. MOTYPE=NOTYPE
  327. TYPE(1)='REAL*8'
  328. TYPE(2)='POINTEUREVOLUTIO'
  329. ELSE
  330. NBROBL=1
  331. SEGINI NOMID
  332. MOMATR=NOMID
  333. LESOBL(1)='YOUN'
  334. *
  335. NBTYPE=1
  336. SEGINI NOTYPE
  337. MOTYPE=NOTYPE
  338. TYPE(1)='REAL*8'
  339. ENDIF
  340. *
  341. NMATR=NBROBL
  342. NMATF=NBRFAC
  343. NMATT=NMATR+NMATF
  344. CALL KOMCHA(IPCHE3,IPMAIL,CONM,MOMATR,MOTYPE,
  345. . 1,INFOS,3,IVAMAT)
  346. SEGSUP NOTYPE
  347. IF (IERR.NE.0) GOTO 9930
  348.  
  349. IF (ISUPMA.EQ.1) THEN
  350. CALL VALCHE(IVAMAT,NMATT,IPMIN1,IPPORE,MOMATR,MELE)
  351. IF(IERR.NE.0)THEN
  352. ISUPMA=0
  353. GOTO 9930
  354. ENDIF
  355. ENDIF
  356. *
  357. * Verification du MCHAML de caracteristiques
  358. *
  359. NBROBL=0
  360. NBRFAC=0
  361. MOCARA=0
  362. IVECT=0
  363. IF (MFR.EQ.3.OR.MFR.EQ.9) THEN
  364. NBROBL=2
  365. SEGINI NOMID
  366. MOCARA=NOMID
  367. LESOBL(1)='EPAI'
  368. LESOBL(2)='CALF'
  369. *
  370. NBTYPE=1
  371. SEGINI NOTYPE
  372. MOTYPE=NOTYPE
  373. TYPE(1)='REAL*8'
  374. ENDIF
  375. *
  376. * POUR LES POUTRES
  377. *
  378. IF (MFR.EQ.7 ) THEN
  379. NBROBL=4
  380. NBRFAC=6
  381. SEGINI NOMID
  382. MOCARA=NOMID
  383. LESOBL(1)='TORS'
  384. LESOBL(2)='INRY'
  385. LESOBL(3)='INRZ'
  386. LESOBL(4)='SECT'
  387. LESFAC(1)='SECY'
  388. LESFAC(2)='SECZ'
  389. LESFAC(3)='DX '
  390. LESFAC(4)='DY '
  391. LESFAC(5)='DZ '
  392. LESFAC(6)='VECT'
  393. IVECT=1
  394. *
  395. NBTYPE=10
  396. SEGINI NOTYPE
  397. MOTYPE=NOTYPE
  398. TYPE(1)='REAL*8'
  399. TYPE(2)='REAL*8'
  400. TYPE(3)='REAL*8'
  401. TYPE(4)='REAL*8'
  402. TYPE(5)='REAL*8'
  403. TYPE(6)='REAL*8'
  404. TYPE(7)='REAL*8'
  405. TYPE(8)='REAL*8'
  406. TYPE(9)='REAL*8'
  407. TYPE(10)='POINTEURPOINT '
  408. *
  409. * POUR LES TUYAUX
  410. *
  411. ELSE IF (MFR.EQ.13) THEN
  412. NBROBL=2
  413. NBRFAC=9
  414. SEGINI NOMID
  415. MOCARA=NOMID
  416. LESOBL(1)='EPAI'
  417. LESOBL(2)='RAYO'
  418. LESFAC(1)='RACO'
  419. LESFAC(2)='PRES'
  420. LESFAC(3)='CISA'
  421. LESFAC(4)='CFFX'
  422. LESFAC(5)='CFMX'
  423. LESFAC(6)='CFMY'
  424. LESFAC(7)='CFMZ'
  425. LESFAC(8)='CFPR'
  426. LESFAC(9)='VECT'
  427. IVECT=1
  428. *
  429. NBTYPE=11
  430. SEGINI NOTYPE
  431. MOTYPE=NOTYPE
  432. TYPE(1)='REAL*8'
  433. TYPE(2)='REAL*8'
  434. TYPE(3)='REAL*8'
  435. TYPE(4)='REAL*8'
  436. TYPE(5)='REAL*8'
  437. TYPE(6)='REAL*8'
  438. TYPE(7)='REAL*8'
  439. TYPE(8)='REAL*8'
  440. TYPE(9)='REAL*8'
  441. TYPE(10)='REAL*8'
  442. TYPE(11)='POINTEURPOINT '
  443. ENDIF
  444. *
  445. IF (MOCARA.NE.0) THEN
  446. CALL KOMCHA(IPCHE3,IPMAIL,CONM,MOCARA,MOTYPE,
  447. . 1,INFOS,3,IVACAR)
  448. SEGSUP NOTYPE
  449. IF (IERR.NE.0) GOTO 9940
  450. *
  451. IF (IVECT.EQ.1) THEN
  452. MPTVAL=IVACAR
  453. IF (IVAL(NBROBL+NBRFAC).EQ.0) THEN
  454. *
  455. * MOT CLE VECT EN CAS DE CONVERSION
  456. *
  457. IVECT=2
  458. NOMID=MOCARA
  459. SEGACT NOMID
  460. NBRFAC=NBRFAC+2
  461. SEGADJ NOMID
  462. MOCARA=NOMID
  463. LESFAC(NBRFAC-2)='VX '
  464. LESFAC(NBRFAC-1)='VY '
  465. LESFAC(NBRFAC )='VZ '
  466. *
  467. NBTYPE=1
  468. SEGINI NOTYPE
  469. MOTYPE=NOTYPE
  470. TYPE(1)='REAL*8'
  471. CALL KOMCHA(IPCHE3,IPMAIL,CONM,MOCARA,MOTYPE,
  472. . 1,INFOS,3,IVACAR)
  473. SEGSUP NOTYPE
  474. IF (IERR.NE.0) GOTO 9940
  475. ENDIF
  476. ENDIF
  477. ENDIF
  478. NCARA=NBROBL
  479. NCARF=NBRFAC
  480. NCARR=NCARA+NCARF
  481. IF (ISUPMA.EQ.1.AND.MOCARA.NE.0) THEN
  482. CALL VALCHE(IVACAR,NCARR,IPMIN1,IPPORE,MOCARA,MELE)
  483. IF(IERR.NE.0)THEN
  484. ISUPMA=0
  485. GOTO 9940
  486. ENDIF
  487. ENDIF
  488. ICARA=NCARR
  489. IF((MFR.EQ.7.OR.MFR.EQ.13).AND.IVECT.EQ.1)ICARA=NCARR+IDIM-1
  490. *
  491. * Creation du MCHAML de la sous zone
  492. *
  493. N2=1
  494. SEGINI MCHAML
  495. ICHAML(ISOUS)=MCHAML
  496. NOMCHE(1)='SCAL'
  497. TYPCHE(1)='REAL*8'
  498. *
  499. * Creation du MELVAL de la composante SCAL
  500. *
  501. N1PTEL=NBG
  502. N1EL=NBELEM
  503. N2PTEL=0
  504. N2EL=0
  505. SEGINI MELVAL
  506. IELVAL(1)=MELVAL
  507. IPMELV=MELVAL
  508. *
  509. * Mise a 0 des variables du COMMON NECOU si besoin
  510. * Les bonnes valeurs sont attribuees selon le materiaux
  511. * ( initialisation selon les cas )
  512. *
  513. IF(INPLAS.EQ.2) GO TO 681
  514. IFOURB=IFOUR
  515. NCOURB=0
  516. IPLAST=0
  517. IMAPLA=1
  518. IT=1
  519. ISOTRO=0
  520. ITYP=0
  521. *
  522. * Correspondance MFR,IFOUR et ITYP faite dans ECOINC
  523. *
  524. * Correspondance MFR,IFOUR et ITYP
  525. * a completer
  526. *
  527. IF(MFR.EQ.1.AND.IFOUR.EQ.-2) ITYP=6
  528. IF(MFR.EQ.1.AND.IFOUR.GE.-1) ITYP=1
  529. IF(MFR.EQ.3) ITYP=2
  530. IF(MFR.EQ.5) ITYP=13
  531. IF(MFR.EQ.7) ITYP=11
  532. IF(MFR.EQ.9) ITYP= 2
  533. *
  534. * cas du coq4 - on ne travaille que sur les 6 eres composantes
  535. *
  536. IF(MFR.EQ.13) ITYP=12
  537. IF(MFR.EQ.25) ITYP=3
  538. IF(MFR.EQ.27) ITYP=4
  539. *
  540. IFLUAG=0
  541. ICINE=0
  542. ITHER=0
  543. IFLUPL=0
  544. ICYCL=0
  545. IBI=0
  546. JFLUAG=0
  547. KFLUAG=0
  548. LFLUAG=0
  549. IRELAX=0
  550. JNTRIN=0
  551. MFLUAG=0
  552. JSOUFL=0
  553. JGRDEF=0
  554. LTRAC=600
  555. *
  556. 681 CONTINUE
  557. *
  558. NCXMAT=NMATT
  559. IF(INPLAS.EQ.5)NCXMAT=NMATT+3
  560. SEGINI WRK0,WRK1,WRK2,WRK3
  561. IF(MFR.EQ.7.OR.MFR.EQ.13) THEN
  562. NBBB=NBNN
  563. SEGINI WRK4
  564. SEGINI WRK6
  565. ENDIF
  566. *
  567. * Boucle sur les elements
  568. *
  569. DO 3004 IB=1,NBELEM
  570. *
  571. * Boucle sur les points de gauss
  572. *
  573. DO 5004 IGAU=1,N1PTEL
  574. *
  575. * On remplit les differentes quantites necessaires a
  576. * ECOULE
  577. *
  578. * Contraintes initiales
  579. *
  580. MPTVAL=IVACON
  581. DO 4004 ICOMP=1,NSTR
  582. MELVAL=IVAL(ICOMP)
  583. IGMN=MIN(IGAU,VELCHE(/1))
  584. IBMN=MIN(IB ,VELCHE(/2))
  585. SIG0(ICOMP)=VELCHE(IGMN,IBMN)
  586. 4004 CONTINUE
  587. *
  588. * Variables internes initiales
  589. *
  590. MPTVAL=IVAVAR
  591. DO 4005 ICOMP=1,NVARI
  592. MELVAL=IVAL(ICOMP)
  593. IGMN=MIN(IGAU,VELCHE(/1))
  594. IBMN=MIN(IB ,VELCHE(/2))
  595. VAR0(ICOMP)=VELCHE(IGMN,IBMN)
  596. 4005 CONTINUE
  597. IEPS=1
  598. EPSPL=VAR0(IEPS)
  599. *
  600. * Les constantes du materiaux
  601. *
  602. MPTVAL=IVAMAT
  603. IF(INPLAS.EQ.5)THEN
  604. MELVAL=IVAL(1)
  605. IBMN=MIN(IB,VELCHE(/2))
  606. IGMN=MIN(IGAU,VELCHE(/1))
  607. XMAT(1)=VELCHE(IGMN,IBMN)
  608. MELVAL=IVAL(2)
  609. IBMN=MIN(IB,IELCHE(/2))
  610. IGMN=MIN(IGAU,IELCHE(/1))
  611. MEVOLL = IELCHE(IGMN,IBMN)
  612. *--------
  613. SEGACT MEVOLL
  614. KEVOLL=IEVOLL(1)
  615. SEGACT KEVOLL
  616. MLREEL = IPROGY
  617. SEGACT MLREEL
  618. LTR2 = PROG(/1)
  619. SEGDES MLREEL,KEVOLL,MEVOLL
  620. IF(LTR2.GT.LTRAC) THEN
  621. LTRAC = LTR2
  622. SEGADJ WRK0
  623. ENDIF
  624. XMAT(5)=MEVOLL
  625. ELSE
  626. DO 4007 ICOMP=1,NMATR
  627. MELVAL=IVAL(ICOMP)
  628. IF(TYVAL(ICOMP)(1:8).NE.'POINTEUR')THEN
  629. IBMN=MIN(IB,VELCHE(/2))
  630. IGMN=MIN(IGAU,VELCHE(/1))
  631. XMAT(ICOMP)=VELCHE(IGMN,IBMN)
  632. ELSE
  633. IBMN=MIN(IB,IELCHE(/2))
  634. IGMN=MIN(IGAU,IELCHE(/1))
  635. * XMAT(ICOMP)=IELCHE(IGMN,IBMN)
  636. MEVOLL = IELCHE(IGMN,IBMN)
  637. SEGACT MEVOLL
  638. KEVOLL=IEVOLL(1)
  639. SEGACT KEVOLL
  640. MLREEL = IPROGY
  641. SEGACT MLREEL
  642. LTR2 = PROG(/1)
  643. SEGDES MLREEL,KEVOLL,MEVOLL
  644. IF(LTR2.GT.LTRAC) THEN
  645. LTRAC = LTR2
  646. SEGADJ WRK0
  647. ENDIF
  648. XMAT(5)=MEVOLL
  649. *---------------
  650. ENDIF
  651. 4007 CONTINUE
  652. ENDIF
  653. IYUNG=1
  654. ETANG=XMAT(IYUNG)
  655. *
  656. * Les caracteristiques si besoin
  657. *
  658. IF (ITYP.EQ.2) THEN
  659. ALFAH=1.
  660. IF(MOCARA.NE.0) THEN
  661. MPTVAL=IVACAR
  662. DO 6029 ICOMP=1,NCARR
  663. MELVAL=IVAL(ICOMP)
  664. IBMN=MIN(IB ,VELCHE(/2))
  665. XCAR(ICOMP)=VELCHE(1,IBMN)
  666. 6029 CONTINUE
  667. IALF=2
  668. ALFAH=XCAR(IALF)*XCAR(IALF)
  669. ENDIF
  670. *
  671. * On transforme les efforts en contraintes pour les
  672. * coques minces
  673. *
  674. CALL EFCONT(XCAR(1),0.D0,NSTRS,SIG0)
  675. IF (NVARI.EQ.NSTRS+1) THEN
  676. CALL EFCONT(XCAR(1),0.D0,NSTRS,VAR0(2))
  677. ENDIF
  678. ENDIF
  679. *
  680. * cas des tuyaux
  681. *
  682. IF (ITYP.EQ.12) THEN
  683. IF(MOCARA.NE.0) THEN
  684. MPTVAL=IVACAR
  685. DO 5129 ICOMP=1,5
  686. MELVAL=IVAL(ICOMP)
  687. IF (MELVAL.NE.0) THEN
  688. IGMN=MIN(IGAU,VELCHE(/1))
  689. IBMN=MIN(IB ,VELCHE(/2))
  690. XCAR(ICOMP)=VELCHE(IGMN,IBMN)
  691. ELSE
  692. XCAR(ICOMP)=0.D0
  693. ENDIF
  694. 5129 CONTINUE
  695. IF(IVECT.EQ.1) THEN
  696. DO 5130 ICOMP=6,NCARR-1
  697. MELVAL=IVAL(ICOMP)
  698. IF (MELVAL.NE.0) THEN
  699. IGMN=MIN(IGAU,VELCHE(/1))
  700. IBMN=MIN(IB ,VELCHE(/2))
  701. XCAR(ICOMP)=VELCHE(IGMN,IBMN)
  702. ELSE
  703. XCAR(ICOMP)=-1.D0
  704. ENDIF
  705. 5130 CONTINUE
  706. IF (IVAL(NCARR).NE.0) THEN
  707. MELVAL=IVAL(NCARR)
  708. IBMN=MIN(IB,IELCHE(/2))
  709. IGMN=MIN(IGAU,IELCHE(/1))
  710. IP=IELCHE(IGMN,IBMN)
  711. IREF=(IP-1)*(IDIM+1)
  712. DO 5229 IC=1,IDIM
  713. XCAR(NCARR+IC-1)=XCOOR(IREF+IC)
  714. 5229 CONTINUE
  715. ELSE
  716. DO 5329 IC=1,IDIM
  717. XCAR(NCARR+IC-1)=0.D0
  718. 5329 CONTINUE
  719. ENDIF
  720. ELSE
  721. DO 5330 ICOMP=6,10
  722. MELVAL=IVAL(ICOMP)
  723. IF (MELVAL.NE.0) THEN
  724. IGMN=MIN(IGAU,VELCHE(/1))
  725. IBMN=MIN(IB ,VELCHE(/2))
  726. XCAR(ICOMP)=VELCHE(IGMN,IBMN)
  727. ELSE
  728. XCAR(ICOMP)=-1.D0
  729. ENDIF
  730. 5330 CONTINUE
  731. DO 5339 ICOMP=11,ICARA
  732. MELVAL=IVAL(ICOMP)
  733. IF (MELVAL.NE.0) THEN
  734. IGMN=MIN(IGAU,VELCHE(/1))
  735. IBMN=MIN(IB ,VELCHE(/2))
  736. XCAR(ICOMP)=VELCHE(IGMN,IBMN)
  737. ELSE
  738. XCAR(ICOMP)=0.D0
  739. ENDIF
  740. 5339 CONTINUE
  741. ENDIF
  742. *
  743. * REARRANGEMENT DU TABLEAU XCAR POUR QU'ON AI LA MEME ORDRE
  744. * QUE L'ANCIEN CHAMELEM
  745. *
  746. NWORK = 7
  747. DO 5349 IC=4,10
  748. WORK(IC-3)=XCAR(IC)
  749. 5349 CONTINUE
  750. IF(IDIM.EQ.2)THEN
  751. XCAR(4)=XCAR(ICARA-1)
  752. XCAR(5)=XCAR(ICARA)
  753. DO 5359 IC=1,NWORK
  754. XCAR(IC+5)=WORK(IC)
  755. 5359 CONTINUE
  756. ELSE IF(IDIM.EQ.3)THEN
  757. XCAR(4)=XCAR(ICARA-2)
  758. XCAR(5)=XCAR(ICARA-1)
  759. XCAR(6)=XCAR(ICARA)
  760. DO 5369 IC=1,NWORK
  761. XCAR(IC+6)=WORK(IC)
  762. 5369 CONTINUE
  763. ENDIF
  764. ENDIF
  765. ENDIF
  766. *
  767. * cas des poutres
  768. *
  769. IF (ITYP.EQ.11) THEN
  770. IF(MOCARA.NE.0) THEN
  771. MPTVAL=IVACAR
  772. IF(IVECT.EQ.1) THEN
  773. DO 6129 ICOMP=1,NCARR-1
  774. MELVAL=IVAL(ICOMP)
  775. IF (MELVAL.NE.0) THEN
  776. IGMN=MIN(IGAU,VELCHE(/1))
  777. IBMN=MIN(IB ,VELCHE(/2))
  778. XCAR(ICOMP)=VELCHE(IGMN,IBMN)
  779. ELSE
  780. XCAR(ICOMP)=0.D0
  781. ENDIF
  782. 6129 CONTINUE
  783. IF (IVAL(NCARR).NE.0) THEN
  784. MELVAL=IVAL(NCARR)
  785. IBMN=MIN(IB,IELCHE(/2))
  786. IGMN=MIN(IGAU,IELCHE(/1))
  787. IP=IELCHE(IGMN,IBMN)
  788. IREF=(IP-1)*(IDIM+1)
  789. DO 6229 IC=1,IDIM
  790. XCAR(NCARR+IC-1)=XCOOR(IREF+IC)
  791. 6229 CONTINUE
  792. ELSE
  793. DO 6329 IC=1,IDIM
  794. XCAR(NCARR+IC-1)=0.D0
  795. 6329 CONTINUE
  796. ENDIF
  797. ELSE
  798. DO 6339 ICOMP=1,ICARA
  799. MELVAL=IVAL(ICOMP)
  800. IF (MELVAL.NE.0) THEN
  801. IGMN=MIN(IGAU,VELCHE(/1))
  802. IBMN=MIN(IB ,VELCHE(/2))
  803. XCAR(ICOMP)=VELCHE(IGMN,IBMN)
  804. ELSE
  805. XCAR(ICOMP)=0.D0
  806. ENDIF
  807. 6339 CONTINUE
  808. ENDIF
  809. *
  810. * REARRANGEMENT DU TABLEAU XCAR POUR QU'ON AI LA MEME ORDRE
  811. * QUE L'ANCIEN CHAMELEM
  812. *
  813. IF(IDIM.EQ.2)THEN
  814. VX=XCAR(ICARA-3)
  815. VY=XCAR(ICARA-2)
  816. XCAR(ICARA-3)=XCAR(ICARA-1)
  817. XCAR(ICARA-2)=XCAR(ICARA)
  818. XCAR(ICARA-1)=VX
  819. XCAR(ICARA)=VY
  820. ELSEIF(IDIM.EQ.3)THEN
  821. VX=XCAR(ICARA-5)
  822. VY=XCAR(ICARA-4)
  823. VZ=XCAR(ICARA-3)
  824. XCAR(ICARA-5)=XCAR(ICARA-2)
  825. XCAR(ICARA-4)=XCAR(ICARA-1)
  826. XCAR(ICARA-3)=XCAR(ICARA)
  827. XCAR(ICARA-2)=VX
  828. XCAR(ICARA-1)=VY
  829. XCAR(ICARA)=VZ
  830. ENDIF
  831. ENDIF
  832. ENDIF
  833. C
  834. IF(ITYP.EQ.11) THEN
  835. DIV(1)=1.D0/XCAR(4)
  836. DIV(2)=1.D0
  837. DIV(3)=1.D0
  838. DIV(4)=XCAR(5)/XCAR(1)
  839. DIV(5)=XCAR(6)/XCAR(2)
  840. DIV(6)=XCAR(7)/XCAR(3)
  841. IF(DIV(4).EQ.0.D0) DIV(4)=1.D-10/SQRT(XCAR(1)*XCAR(4))
  842. IF(DIV(5).EQ.0.D0) DIV(5)=1.D-10/SQRT(XCAR(2)*XCAR(4))
  843. IF(DIV(6).EQ.0.D0) DIV(6)=1.D-10/SQRT(XCAR(3)*XCAR(4))
  844. ENDIF
  845. C
  846. IF(ITYP.EQ.12) THEN
  847. EPAIS=XCAR(1)
  848. REXT =XCAR(2)
  849. RMOY =REXT-EPAIS*0.5D0
  850. RACO =XCAR(3)
  851. PRES =XCAR(4)
  852. CISA =XCAR(5)
  853. C
  854. GAM=1.D0
  855. IF(RACO.EQ.0.D0) GO TO 6429
  856. XLAM=RMOY*RMOY/EPAIS/RACO
  857. GAM=0.8888888888888889D0*(XLAM)**0.6666666666666667D0
  858. IF(GAM.LT.1.D0) GAM=1.D0
  859. 6429 CONTINUE
  860. C
  861. C NB 23/09/98
  862. C VALEURS PAR DEFAUT POUR LES CFFX CFMX CFMY
  863. C CFMZ CFPR ( COEFFICIENTS POUR CALCULER LES
  864. C CONTRAINTES DE MEMBRANE, TORSION, FLEXIONS
  865. C DANS LE PLAN, HORS PLAN ET CIRCONFERENTIELLE
  866. C DUE A LA PRESSION )
  867. C POUR L'INSTANT PAS DE CONTRAINTE CIRCONFERENTIELLE
  868. C DUE A LA PRESSION ON N'UTILISE DONC PAS DIV(7)
  869. C
  870. C
  871. DIV(1)=1.D0
  872. DIV(2)=1.D0
  873. DIV(3)=1.D0
  874. DIV(4)=R33
  875. DIV(5)=PI4*GAM
  876. DIV(6)=DIV(5)
  877. DIV(7)=0.D0
  878. C
  879. IF(IDIM.EQ.2) THEN
  880. PRES1=XCAR(6)
  881. CISA1=XCAR(7)
  882. IDEB1=8
  883. ELSE IF(IDIM.EQ.3) THEN
  884. PRES1=XCAR(7)
  885. CISA1=XCAR(8)
  886. IDEB1=9
  887. ENDIF
  888. C
  889. JDIV1=2
  890. DO 6529 ICOMP=IDEB1,ICARA
  891. JDIV1=JDIV1+1
  892. VCAR1=XCAR(ICOMP)
  893. IF (VCAR1.NE.-1.D0) DIV(JDIV1)=XCAR(ICOMP)
  894. 6529 CONTINUE
  895. C
  896. C NB 23/09/98
  897. C TRANSFERT DE CFFX DANS DIV(1) ET REMISE A
  898. C 1.D0 DE DIV(3)
  899. C
  900. DIV(1) = DIV(3)
  901. DIV(3)=1.D0
  902. C
  903. IF(IDIM.EQ.2) CISA=XCAR(7)
  904. IF(IDIM.EQ.3) CISA=XCAR(8)
  905. VX=XCAR(4)
  906. VY=XCAR(5)
  907. VZ=XCAR(6)
  908. CALL TUYCAR(XCAR,CISA,VX,VY,VZ,KERRE,1)
  909. DIV(1)=DIV(1)/XCAR(4)
  910. DIV(4)=DIV(4)*RMOY/XCAR(1)
  911. DIV(5)=DIV(5)*RMOY/XCAR(2)
  912. DIV(6)=DIV(6)*RMOY/XCAR(3)
  913. ENDIF
  914. *
  915. * On transforme les efforts en contraintes pour les
  916. * poutres et tuyaux
  917. *
  918. IF (ITYP.EQ.11.OR.ITYP.EQ.12) THEN
  919. DO 6629 ICOMP=1,NSTR
  920. SIG0(ICOMP)=SIG0(ICOMP)*DIV(ICOMP)
  921. 6629 CONTINUE
  922. ENDIF
  923. *______________________________________________________________________
  924. *
  925. * MATERIAU PUREMENT ELASTIQUE
  926. *_____________________________________________________________________
  927. *
  928. IF(INPLAS.EQ.0) THEN
  929. GO TO 510
  930. ENDIF
  931. *======================================================================
  932. *
  933. * NUMERO DES ETIQUETTES :
  934. *
  935. * 1 A 99 POUR LES MODELES DE PLASTICITE ( INDICE INPLAS )
  936. *
  937. *======================================================================
  938. *
  939. GOTO (1, 2,99, 4, 5,99, 7,99,99,99, 7, 7, 7,99,99,99,99,99,99,99,
  940. & 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  941. & 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  942. & 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99),INPLAS
  943. *
  944. 99 CONTINUE
  945. MOTERR(1:4)=NOMAC(INPLAS)
  946. MOTERR(5:12)=NOMFR(MFR)
  947. CALL ERREUR(269)
  948. SEGSUP MCHAML
  949. MELVAL=IPMELV
  950. SEGSUP MELVAL
  951. GOTO 9940
  952. *_______________________________________________________________________
  953. *
  954. * MODELE VON MISES ISOTROPE ASSOCIE ( D'APRES INCA )
  955. *_______________________________________________________________________
  956. *
  957. 1 CONTINUE
  958. *
  959. * Cas de la plasticite parfaite
  960. *
  961. NCOURB=2
  962. TRAC(1)=XMAT(2)
  963. TRAC(2)=0.D0
  964. TRAC(3)=XMAT(2)
  965. TRAC(4)=1.D0
  966. IF(XMAT(2).EQ.0.D0) THEN
  967. KERRE=33
  968. GO TO 510
  969. ENDIF
  970. *
  971. * On cherche si on est sur la surface de charge
  972. *
  973. IF(EPSPL.EQ.0.) GO TO 682
  974. SIGVM=VONMIS(SIG0,ITYP,ALFAH,COMIS)
  975. IF(SIGVM.LT.PRECIS*TRAC(1)) GO TO 682
  976. ETANG=0.
  977. GOTO 682
  978. *
  979. 4 CONTINUE
  980. *
  981. * Cas de la plasticite cinematique bilineaire
  982. *
  983. ICINE=1
  984. NCOURB=2
  985. TRAC(1)=XMAT(2)
  986. TRAC(2)=0.D0
  987. TRAC(3)=XMAT(2)+XMAT(3)
  988. TRAC(4)=1.D0
  989. IF(XMAT(2).EQ.0.D0) THEN
  990. KERRE=33
  991. GO TO 510
  992. ENDIF
  993. *
  994. * On cherche si on est sur la surface de charge
  995. *
  996. IF(EPSPL.EQ.0.) GO TO 682
  997. ISPHER=2
  998. CALL AEQBPC(SIG0,SIG0,VAR0(ISPHER),1.D0,-1.D0,NSTRS)
  999. *
  1000. SIGVM=VONMIS(SIG0,ITYP,ALFAH,COMIS)
  1001. IF(SIGVM.LT.PRECIS*TRAC(1)) GO TO 682
  1002. H=TRAC(3)
  1003. ETANG=ETANG*H/(ETANG+H)
  1004. GOTO 682
  1005. C
  1006. 5 CONTINUE
  1007. *
  1008. * Cas de la plasticite isotrope ecrouissable
  1009. *
  1010. * On recupere la courbe de traction
  1011. *
  1012. CALL COTRAC(WRK0,WRK2,NCOURB,KERRE)
  1013. IF(KERRE.GT.0) GO TO 510
  1014. IF(EPSPL.EQ.0.) GO TO 682
  1015. LSIG=NCOURB
  1016. SEGINI WRK5
  1017. *
  1018. DO 7000 IZ=1,LSIG
  1019. SIG(IZ)=TRAC(2*(IZ-1)+1)
  1020. EPS(IZ)=TRAC(2*IZ)
  1021. 7000 CONTINUE
  1022. *
  1023. CALL TRACTI(SELAS,EPSPL,SIG,EPS,NCOURB,2,IBI)
  1024. IF(IBI.NE.0) THEN
  1025. KERRE=75
  1026. GO TO 510
  1027. ENDIF
  1028. SIGVM=VONMIS(SIG0,ITYP,ALFAH,COMIS)
  1029. *
  1030. IF(SIGVM.LT.PRECIS*SELAS) GO TO 7001
  1031. CALL TRACTI(H,EPSPL,SIG,EPS,NCOURB,1,IBI)
  1032. IF(IBI.NE.0) THEN
  1033. KERRE=75
  1034. GO TO 510
  1035. ENDIF
  1036. ETANG=ETANG*H/(ETANG+H)
  1037. *
  1038. 7001 CONTINUE
  1039. SEGSUP WRK5
  1040. GO TO 682
  1041. *
  1042. 7 CONTINUE
  1043. *
  1044. * Cas du modele CHABOCHE
  1045. *
  1046. ICINE=1
  1047. IMAPLA=4
  1048. GOTO 682
  1049. *
  1050. 682 CONTINUE
  1051. DO 675 IC=1,NCARR
  1052. WORK(IC)=XCAR(IC)
  1053. 675 CONTINUE
  1054. GOTO 510
  1055. *
  1056. * Modele LINESPRING
  1057. *
  1058. 2 CONTINUE
  1059. GOTO 510
  1060. *
  1061. 510 CONTINUE
  1062. *
  1063. *
  1064. * Remplissage du segment contenant les contraintes a la fin
  1065. *
  1066. IF (KERRE.EQ.0) THEN
  1067. MELVAL=IPMELV
  1068. VELCHE(IGAU,IB)=ETANG
  1069. *
  1070. * Impression des message d'erreurs
  1071. *
  1072. ELSE IF(KERRE.NE.0) THEN
  1073. IRT0=0
  1074. IRT6=0
  1075. IRT7=0
  1076. INTERR(1)=IB
  1077. INTERR(2)=IGAU
  1078. MOTERR(1:4)=NOMTP(MELE)
  1079. IF(KERRE.EQ.1) THEN
  1080. CALL ERREUR(267)
  1081. ELSE IF(KERRE.EQ.2) THEN
  1082. CALL ERREUR(268)
  1083. ELSE IF(KERRE.EQ.30) THEN
  1084. CALL ERREUR(270)
  1085. ELSE IF(KERRE.EQ.31) THEN
  1086. CALL ERREUR(271)
  1087. ELSE IF(KERRE.EQ.32) THEN
  1088. CALL ERREUR(272)
  1089. ELSE IF(KERRE.EQ.33) THEN
  1090. CALL ERREUR(273)
  1091. ELSE IF(KERRE.EQ.34) THEN
  1092. CALL ERREUR(325)
  1093. ELSE IF(KERRE.EQ.35) THEN
  1094. CALL ERREUR(331)
  1095. ELSE IF(KERRE.EQ.36) THEN
  1096. CALL ERREUR(330)
  1097. ELSE IF(KERRE.EQ.37) THEN
  1098. CALL ERREUR(354)
  1099. ELSE IF(KERRE.EQ.21) THEN
  1100. CALL ERREUR(276)
  1101. ELSE IF(KERRE.EQ.22) THEN
  1102. CALL ERREUR(275)
  1103. ELSE IF(KERRE.EQ.75) THEN
  1104. CALL ERREUR(876)
  1105. ENDIF
  1106. GOTO 444
  1107. ENDIF
  1108. *
  1109. 5004 CONTINUE
  1110. 3004 CONTINUE
  1111. *
  1112. 444 CONTINUE
  1113. SEGSUP WRK0,WRK1,WRK2,WRK3
  1114. IF(MFR.EQ.7.OR.MFR.EQ.13) THEN
  1115. SEGSUP WRK4,WRK6
  1116. ENDIF
  1117. *
  1118. IF (ISUPCO.EQ.1) THEN
  1119. CALL DTMVAL (IVACON,3)
  1120. ELSE
  1121. CALL DTMVAL (IVACON,1)
  1122. ENDIF
  1123. *
  1124. IF (ISUPVA.EQ.1) THEN
  1125. CALL DTMVAL (IVAVAR,3)
  1126. ELSE
  1127. CALL DTMVAL (IVAVAR,1)
  1128. ENDIF
  1129. *
  1130. IF (ISUPMA.EQ.1) THEN
  1131. CALL DTMVAL (IVAMAT,3)
  1132. ELSE
  1133. CALL DTMVAL (IVAMAT,1)
  1134. ENDIF
  1135. *
  1136. IF (ISUPMA.EQ.1) THEN
  1137. CALL DTMVAL (IVACAR,3)
  1138. ELSE
  1139. CALL DTMVAL (IVACAR,1)
  1140. ENDIF
  1141. *
  1142. SEGDES,MINTE
  1143. SEGDES MELEME
  1144. NOMID=MOCONT
  1145. if(lsupco)SEGSUP NOMID
  1146. NOMID=MOVARI
  1147. if(lsupva)SEGSUP NOMID
  1148. NOMID=MOMATR
  1149. SEGSUP NOMID
  1150. IF (MOCARA.NE.0) THEN
  1151. NOMID=MOCARA
  1152. SEGSUP NOMID
  1153. ENDIF
  1154. * INFO=IPINF
  1155. * SEGSUP INFO
  1156. SEGDES IMODEL
  1157. *
  1158. IF(KERRE.NE.0)THEN
  1159. SEGSUP MCHAML
  1160. MELVAL=IPMELV
  1161. SEGSUP MELVAL
  1162. GOTO 888
  1163. ELSE
  1164. SEGDES MCHAML
  1165. MELVAL=IPMELV
  1166. SEGDES MELVAL
  1167. ENDIF
  1168. *
  1169. 500 CONTINUE
  1170. *
  1171. 888 CONTINUE
  1172. SEGDES MMODEL
  1173. IF(KERRE.NE.0) THEN
  1174. IRET=0
  1175. SEGSUP MCHELM
  1176. ELSE
  1177. IRET=1
  1178. SEGDES MCHELM
  1179. ENDIF
  1180. C
  1181. RETURN
  1182. *______________________________________________________________________
  1183. *
  1184. * Erreurs dans une sous zone desactivation et retour
  1185. *______________________________________________________________________
  1186. *
  1187. 9940 CONTINUE
  1188. IF (ISUPMA.EQ.1) THEN
  1189. CALL DTMVAL (IVACAR,3)
  1190. ELSE
  1191. CALL DTMVAL (IVACAR,1)
  1192. ENDIF
  1193. NOMID=MOCARA
  1194. IF(NOMID.NE.0)SEGSUP NOMID
  1195. *
  1196. 9930 CONTINUE
  1197. IF (ISUPMA.EQ.1) THEN
  1198. CALL DTMVAL (IVAMAT,3)
  1199. ELSE
  1200. CALL DTMVAL (IVAMAT,1)
  1201. ENDIF
  1202. NOMID=MOMATR
  1203. IF(NOMID.NE.0)SEGSUP NOMID
  1204. *
  1205. 9920 CONTINUE
  1206. IF (ISUPVA.EQ.1) THEN
  1207. CALL DTMVAL (IVAVAR,3)
  1208. ELSE
  1209. CALL DTMVAL (IVAVAR,1)
  1210. ENDIF
  1211. NOMID=MOVARI
  1212. IF(lsupva.and.NOMID.NE.0)SEGSUP NOMID
  1213. *
  1214. 9910 CONTINUE
  1215. IF (ISUPCO.EQ.1) THEN
  1216. CALL DTMVAL (IVACON,3)
  1217. ELSE
  1218. CALL DTMVAL (IVACON,1)
  1219. ENDIF
  1220. NOMID=MOCONT
  1221. IF(lsupco.and.NOMID.NE.0)SEGSUP NOMID
  1222. *
  1223. 9901 CONTINUE
  1224. SEGDES,MELEME,MINTE
  1225. 9900 CONTINUE
  1226. SEGDES IMODEL,MMODEL
  1227. SEGSUP MCHELM
  1228. IRET = 0
  1229.  
  1230. RETURN
  1231. END
  1232.  
  1233.  
  1234.  
  1235.  
  1236.  
  1237.  
  1238.  

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