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

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