Télécharger kcent1.eso

Retour à la liste

Numérotation des lignes :

  1. C KCENT1 SOURCE CB215821 17/01/16 21:15:51 9279
  2. SUBROUTINE KCENT1 (IPMODL,IPCHE1,IPROTA,IPRIG,IFLAM,IRET)
  3. *
  4. *_______________________________________________________________________
  5. *
  6. * appelé par KCENTR ( opérateur KCEN )
  7. *
  8. * Creation d'une matrice de raideur centrifuge
  9. * (Calcul dans un repère tournant)
  10. *
  11. * entrees :
  12. * ========
  13. *
  14. * ipmodl pointeur sur un mmodel
  15. * ipche1 pointeur sur un mchaml de caracteristique
  16. * iprota pointeur sur un point (vecteur vitesse de rotation)
  17. * iflam vrai si on se sert de la matrice pour des calculs de flambage
  18. *
  19. * sorties :
  20. * =========
  21. *
  22. * iprig pointeur sur la matrice de raideur centrifuge
  23. * iret 1 si ok, 0 sinon
  24. *
  25. * Didier COMBESCURE mars 2003
  26. *_______________________________________________________________________
  27. IMPLICIT INTEGER(I-N)
  28. IMPLICIT REAL*8(A-H,O-Z)
  29. -INC CCOPTIO
  30. -INC CCHAMP
  31. -INC CCGEOME
  32. -INC CCREEL
  33. -INC SMRIGID
  34. -INC SMCHAML
  35. -INC SMELEME
  36. -INC SMCOORD
  37. -INC SMINTE
  38. -INC SMMODEL
  39. C
  40. SEGMENT NOTYPE
  41. CHARACTER*16 TYPE(NBTYPE)
  42. ENDSEGMENT
  43. C
  44. SEGMENT MPTVAL
  45. INTEGER IPOS(NS),NSOF(NS)
  46. INTEGER IVAL(NCOSOU)
  47. CHARACTER*16 TYVAL(NCOSOU)
  48. ENDSEGMENT
  49. C
  50. CHARACTER*8 CMATE
  51. CHARACTER*(NCONCH) CONM
  52. PARAMETER (NINF=3)
  53. INTEGER INFOS(NINF)
  54. LOGICAL lsupfo,lsupdp
  55. C
  56. DIMENSION VROT(3)
  57. C
  58. NHRM=NIFOUR
  59. C
  60. IRET = 0
  61. C
  62. C ACTIVATION DU MODELE
  63. C
  64. MMODEL=IPMODL
  65. SEGACT MMODEL
  66. NSOUS=KMODEL(/1)
  67. C
  68. C CREATION DE L'OBJET MATRICE DE RAIDEUR CENTRIFUGE
  69. C
  70. NRIGEL=NSOUS
  71. SEGINI MRIGID
  72. IF (IFLAM.NE.0) THEN
  73. MTYMAT='MASSE'
  74. ELSE
  75. MTYMAT='RIGIDITE'
  76. ENDIF
  77. IFORIG=IFOMOD
  78. ICHOLE=0
  79. IMGEO1=0
  80. IMGEO2=0
  81. C
  82. ISUPEQ=0
  83. C
  84. C BOUCLE SUR LES SOUS ZONES
  85. C
  86. DO 499 ISOUS=1,NSOUS
  87. IRIGEL(4,ISOUS)=0
  88. COERIG(ISOUS)=1.D0
  89. 499 CONTINUE
  90. C_______________________________________________________________________
  91. C
  92. C DEBUT DE LA BOUCLE SUR LES DIFFERENTES SOUS ZONES
  93. C_______________________________________________________________________
  94. C
  95. DO 500 ISOUS=1,NSOUS
  96. C
  97. C ON RECUPERE LINFORMATION GENERALES
  98. C
  99. IMODEL=KMODEL(ISOUS)
  100. SEGACT IMODEL
  101. IIPDPG=IPDPGE
  102. IPMAIL=IMAMOD
  103. CONM =CONMOD
  104. C
  105. C TRAITEMENT DU MODELE
  106. C
  107. MELEME=IMAMOD
  108. MELE=NEFMOD
  109. NFOR=FORMOD(/2)
  110. NMAT=MATMOD(/2)
  111. npint=1
  112. if (infmod(/1).ne.0) npint = infmod(1)
  113. C
  114. C NATURE DU MATERIAU
  115. C
  116. CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT)
  117. IF (CMATE.EQ.' ') THEN
  118. CALL ERREUR(251)
  119. SEGDES IMODEL
  120. GOTO 9997
  121. ENDIF
  122. C_______________________________________________________________________
  123. C
  124. C INFORMATION SUR L ELEMENT FINI
  125. C_______________________________________________________________________
  126. C
  127. * if (npint.eq.12345) then
  128. * integration aux noeuds
  129. * CALL ELQUOI(MELE,0,1,IPINF,IMODEL)
  130. * else
  131. * CALL ELQUOI(MELE,0,4,IPINF,IMODEL)
  132. * endif
  133. iplaz=4
  134. if (npint.eq.12345) iplaz=1
  135. * IF (IERR.NE.0) THEN
  136. * SEGDES IMODEL
  137. * GOTO 9997
  138. * ENDIF
  139. MFR =INFELE(13)
  140. LRE =INFELE(9)
  141. LW =INFELE(7)
  142. LHOOK =INFELE(10)
  143. NDDL =INFELE(15)
  144. IELE=INFELE(14)
  145. ICARA=INFELE(5)
  146. * MINTE=INFELE(11)
  147. MINTE=INFMOD(2+iplaz)
  148. MINTE1=INFMOD(8)
  149. IPMINT=MINTE
  150. IPMIN1=MINTE1
  151. C
  152. C INITIALISATION DE MINTE
  153. C
  154. SEGACT,MINTE
  155. NBPGAU=POIGAU(/1)
  156. C
  157. C CREATION DU TABLEAU INFOS
  158. C
  159. CALL IDENT(IPMAIL,CONM,IPCHE1,0,INFOS,IRTD)
  160. IF (IRTD.EQ.0) GOTO 9996
  161. C
  162. C ON RECUPERE LES MELVAL ET LES MELEME
  163. C
  164. MELEME=IPMAIL
  165. SEGACT MELEME
  166. *
  167. * modification du meleme pour le remplissage du segment descripteur
  168. * en deformations planes generalisees
  169. *
  170. NBNN =NUM(/1)
  171. NBELEM=NUM(/2)
  172. IPPORE=0
  173. IF(MFR.EQ.33) IPPORE=NBNN
  174. C
  175. C ---------------------------------------------------------*
  176. C INITIALISATION DU SEGMENT DESCR, SEGMENT DESCRIPTEUR DES *
  177. C DES INCONNUES RELATIVES A LA MATRICE DE RIGIDITE *
  178. C ---------------------------------------------------------*
  179. NLIGRP = INFELE(9)
  180. NLIGRD = INFELE(9)
  181. SEGINI DESCR
  182. IPDSCR=DESCR
  183. if(lnomid(1).ne.0) then
  184. nomid=lnomid(1)
  185. segact nomid
  186. modepl=nomid
  187. ndepl=lesobl(/2)
  188. ndum=lesfac(/2)
  189. lsupdp=.false.
  190. else
  191. lsupdp=.true.
  192. CALL IDPRIM(IMODEL,MFR,MODEPL,NDEPL,NDUM)
  193. endif
  194. if(lnomid(2).ne.0) then
  195. nomid=lnomid(2)
  196. segact nomid
  197. moforc=nomid
  198. nforc=lesobl(/2)
  199. lsupfo=.false.
  200. else
  201. lsupfo=.true.
  202. CALL IDDUAL(IMODEL,MFR,MOFORC,NFORC,NDUM)
  203. endif
  204. C
  205. IF (NDEPL.EQ.0.OR.NFORC.EQ.0.OR.NDEPL.NE.NFORC) THEN
  206. CALL ERREUR(5)
  207. SEGSUP DESCR
  208. GOTO 9990
  209. ENDIF
  210. C
  211. C REMPLISSAGE DU SEGMENT DESCRIPTEUR
  212. C
  213. IDDL=1
  214. NCOMP=NDEPL
  215. NBNNS=NBNN
  216. C IF (MFR.EQ.33) NCOMP=NDEPL-1
  217. C IF (IFOUR.EQ.-3) THEN
  218. C NCOMP=NDEPL-3
  219. C NBNNS=NBNN-1
  220. C ENDIF
  221. IF (MFR.EQ.19.OR.MFR.EQ.21) NBNNS=NBNN/2
  222. NOMID=MODEPL
  223. SEGACT NOMID
  224. NOMID=MOFORC
  225. SEGACT NOMID
  226. DO 1004 INOEUD=1,NBNNS
  227. DO 1005 ICOMP=1,NCOMP
  228. NOMID=MODEPL
  229. LISINC(IDDL)=LESOBL(ICOMP)
  230. NOMID=MOFORC
  231. LISDUA(IDDL)=LESOBL(ICOMP)
  232. NOELEP(IDDL)=INOEUD
  233. NOELED(IDDL)=INOEUD
  234. IDDL=IDDL+1
  235. 1005 CONTINUE
  236. 1004 CONTINUE
  237. *
  238. NOMID=MODEPL
  239. SEGDES NOMID
  240. NOMID=MOFORC
  241. SEGDES NOMID
  242. SEGDES DESCR
  243. C
  244. C ------------------------------------------------------------*
  245. C INITIALISATION DU SEGMENT xMATRI, *
  246. C CONTENANT LES MATRICES DE RIGIDITE ELEMENTAIRES *
  247. C ------------------------------------------------------------*
  248. C NBELEM: NB D'ELEMENTS DANS LA SOUS ZONE
  249. NLIGRP=LRE
  250. NLIGRD=LRE
  251. C LVAL=(LRE*(LRE+1))/2
  252. C
  253. NELRIG=NBELEM
  254. SEGINI xMATRI
  255. IPMATR=xMATRI
  256. C
  257. C------------------------------------------------------*
  258. C TRAITEMENT DU CHAPEAU DES RIGIDITES, SEGMENT MRIGID *
  259. C------------------------------------------------------*
  260. C
  261. IRIGEL(1,ISOUS)=IPMAIL
  262. IRIGEL(2,ISOUS)=0
  263. IRIGEL(3,ISOUS)=IPDSCR
  264. IRIGEL(4,ISOUS)=xMATRI
  265. IRIGEL(5,ISOUS)=NHRM
  266. C
  267. C MATRICE SYMETRIQUE
  268. C
  269. IRIGEL(7,ISOUS)=0
  270. C
  271. C_______________________________________________________________________
  272. C
  273. C TRAITEMENT DES CHAMP MATERIAUX
  274. C_______________________________________________________________________
  275. C
  276. NBROBL=0
  277. NBRFAC=0
  278. MOMATR=0
  279. IVAMAT=0
  280. IVACAR=0
  281. LHOTRA=0
  282. *
  283. * rho dans les cas poutre,tuyau, barr et massif
  284. *
  285. IF (MFR.EQ.1.OR.MFR.EQ.27.OR.MFR.EQ.7.OR.MFR.EQ.13.OR.
  286. . MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  287. *
  288. IF(CMATE.NE.'SECTION') THEN
  289. NBROBL=1
  290. SEGINI NOMID
  291. LESOBL(1)='RHO '
  292. NBTYPE=1
  293. SEGINI NOTYPE
  294. TYPE(1)='REAL*8'
  295. ELSE
  296. LHOTRA=LHOOK
  297. NBROBL=2
  298. SEGINI NOMID
  299. MOMATR=NOMID
  300. LESOBL(1)='MODS'
  301. LESOBL(2)='MATS'
  302. NBTYPE=2
  303. SEGINI NOTYPE
  304. TYPE(1)='POINTEURMMODEL'
  305. TYPE(2)='POINTEURMCHAML'
  306. ENDIF
  307. MOMATR=NOMID
  308. MOTYPE=NOTYPE
  309. ENDIF
  310. C
  311. IF (MOMATR.NE.0) THEN
  312. *
  313. * verification du support des composantes recherchees
  314. *
  315. CALL QUESUQ(IMODEL,IPCHE1,4,0,MOMATR,IPLAZ,ISUP,IRET1)
  316. IF(ISUP.GT.1)THEN
  317. GO TO 9990
  318. ENDIF
  319. *
  320. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  321. SEGSUP NOTYPE
  322. IF (IERR.NE.0) GOTO 9990
  323. NMATR=NBROBL
  324. NMATF=NBRFAC
  325. NMATT=NMATR+NMATF
  326. IF(ISUP.EQ.1)THEN
  327. CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  328. IF(IERR.NE.0)THEN
  329. ISUP=0
  330. GOTO 9990
  331. ENDIF
  332. ENDIF
  333. ENDIF
  334. C
  335. NMATR=NBROBL
  336. NMATF=NBRFAC
  337. NMATT=NMATR+NMATF
  338. SEGDES NOMID
  339. C
  340. C____________________________________________________________________
  341. C
  342. C TRAITEMENT DES CHAMPS DE CARACTERISTIQUES
  343. C____________________________________________________________________
  344. C
  345. NBROBL=0
  346. NBRFAC=0
  347. MOCARA=0
  348. NCARA=0
  349. NCARF=0
  350. NCARR=0
  351. IVECT=0
  352. *
  353. * caracteristiques pour les poutres
  354. *
  355. IF (MFR.EQ.7 ) THEN
  356. IF (CMATE.EQ.'SECTION') THEN
  357. NBROBL=0
  358. NBRFAC=2
  359. SEGINI NOMID
  360. MOCARA=NOMID
  361. LESFAC(1)='OMEG'
  362. LESFAC(2)='VECT'
  363. IVECT=1
  364. *
  365. NBTYPE=2
  366. SEGINI NOTYPE
  367. MOTYPE=NOTYPE
  368. TYPE(1)='REAL*8'
  369. TYPE(2)='POINTEURPOINT '
  370. *
  371. ELSE
  372. NBROBL=4
  373. NBRFAC=4
  374. SEGINI NOMID
  375. MOCARA=NOMID
  376. LESOBL(1)='TORS'
  377. LESOBL(2)='INRY'
  378. LESOBL(3)='INRZ'
  379. LESOBL(4)='SECT'
  380. LESFAC(1)='SECY'
  381. LESFAC(2)='SECZ'
  382. LESFAC(3)='OMEG'
  383. LESFAC(4)='VECT'
  384. IVECT=1
  385. *
  386. NBTYPE=8
  387. SEGINI NOTYPE
  388. MOTYPE=NOTYPE
  389. TYPE(1)='REAL*8'
  390. TYPE(2)='REAL*8'
  391. TYPE(3)='REAL*8'
  392. TYPE(4)='REAL*8'
  393. TYPE(5)='REAL*8'
  394. TYPE(6)='REAL*8'
  395. TYPE(7)='REAL*8'
  396. TYPE(8)='POINTEURPOINT '
  397. ENDIF
  398. *
  399. * caracteristiques pour les tuyaux
  400. *
  401. ELSE IF (MFR.EQ.13) THEN
  402. NBROBL=2
  403. NBRFAC=3
  404. SEGINI NOMID
  405. MOCARA=NOMID
  406. LESOBL(1)='EPAI'
  407. LESOBL(2)='RAYO'
  408. LESFAC(1)='RACO'
  409. LESFAC(2)='OMEG'
  410. LESFAC(3)='VECT'
  411. IVECT=1
  412. *
  413. NBTYPE=5
  414. SEGINI NOTYPE
  415. MOTYPE=NOTYPE
  416. TYPE(1)='REAL*8'
  417. TYPE(2)='REAL*8'
  418. TYPE(3)='REAL*8'
  419. TYPE(4)='REAL*8'
  420. TYPE(5)='POINTEURPOINT '
  421. *
  422. * caracteristiques pour les barres
  423. *
  424. ELSE IF (MFR.EQ.27) THEN
  425. NBRFAC=0
  426. NBROBL=1
  427. SEGINI NOMID
  428. MOCARA=NOMID
  429. LESOBL(1)='SECT'
  430. *
  431. NBTYPE=1
  432. SEGINI NOTYPE
  433. MOTYPE=NOTYPE
  434. TYPE(1)='REAL*8'
  435. *
  436. * epaisseur et excentrement dans le cas des coques
  437. *
  438. ELSEIF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  439. NBROBL=1
  440. NBRFAC=1
  441. SEGINI NOMID
  442. MOCARA=NOMID
  443. LESOBL(1)='EPAI'
  444. LESFAC(1)='EXCE'
  445. *
  446. NBTYPE=1
  447. SEGINI NOTYPE
  448. MOTYPE=NOTYPE
  449. TYPE(1)='REAL*8'
  450. *
  451. ENDIF
  452. *
  453. IF (MOCARA.NE.0) THEN
  454. *
  455. * verification du support des composantes recherchees
  456. *
  457. CALL QUESUQ(IMODEL,IPCHE1,4,0,MOCARA,IPLAZ,ISUP,IRET2)
  458. IF(ISUP.GT.1)THEN
  459. GO TO 9990
  460. ENDIF
  461. *
  462. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,IVACAR)
  463. SEGSUP NOTYPE
  464. IF (IERR.NE.0) GOTO 9990
  465. NCARA=NBROBL
  466. NCARF=NBRFAC
  467. NCARR=NCARA+NCARF
  468. IF(ISUP.EQ.1)THEN
  469. CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  470. IF(IERR.NE.0)THEN
  471. ISUP=0
  472. GOTO 9990
  473. ENDIF
  474. ENDIF
  475. ENDIF
  476. NCARA=NBROBL
  477. NCARF=NBRFAC
  478. NCARR=NCARA+NCARF
  479. SEGDES NOMID
  480. C
  481. C____________________________________________________________________
  482. C
  483. C LECTURE DU VECTEUR ROTATION
  484. C____________________________________________________________________
  485. C
  486. IF (IPROTA.NE.0) THEN
  487. IF (IFOUR.NE.1) THEN
  488. IBP1=4*IPROTA
  489. VROT(1)=XCOOR((4*IPROTA) - 3)
  490. VROT(2)=XCOOR((4*IPROTA) - 2)
  491. VROT(3)=XCOOR((4*IPROTA) - 1)
  492. ELSE
  493. IBP1=4*IPROTA
  494. VROT(1)= 0.D0
  495. VROT(2)=XCOOR((3*IPROTA) - 1)
  496. VROT(3)=0.D0
  497. ENDIF
  498. ELSE
  499. VROT(1)=0.D0
  500. VROT(2)=1.D0
  501. VROT(3)=0.D0
  502. ENDIF
  503. C
  504. C_______________________________________________________________________
  505. C
  506. C NUMERO DES ETIQUETTES :
  507. C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  508. C LES ELEMENTS SONT GROUPES COMME SUIT :
  509. C - MASSIF,LIQUIDE 'SURFACE LIBRE' ----------------------> KCENT3
  510. C - COQ3/POUTRE,DKT,COQ4,COQ8,COQ2,DST ------------------> KCENT2
  511. C ET POUTRE DE TIMOSCHENKO
  512. C_______________________________________________________________________
  513. * CABL SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5 QUA8 QUA9
  514. GOTO ( 99, 99, 11, 11, 99, 11, 99, 11, 99, 11, 99
  515. * RAC2 RAC3 CUB8 CU20 PRI6 PR15 LIA3 LIA4 LIA6 LIA8 MULT
  516. & , 99, 99, 11, 11, 11, 11, 99, 99, 99, 99, 99
  517. * TET4 TE10 PYR5 PY13 COQ3 DKT POUT LISP FAC3 FAC4 FAC6
  518. & , 11, 11, 11, 11, 21, 21, 21, 99, 99, 99, 99
  519. * FAC8 LTR3 LQU4 LCU8 LPR6 LTE4 LPY5 COQ8 TUYA TUFI COQ2
  520. & , 99, 99, 99, 99, 99, 99, 99, 21, 21, 99, 21
  521. * POI1 BARR RACO LSU2 COQ4 LISM COF3 RES2 LSU3 LSU4 LICO
  522. & , 99, 21, 99, 99, 21, 99, 99, 99, 99, 99, 99
  523. * COQ6 CVS2 CVS3 CVT3 CVT6 CVQ4 CVQ8 THP5 TH13 THP6 TH15
  524. & , 21, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  525. * THC8 TH20 ICT3 ICQ4 ICT6 ICQ8 ICC8 ICT4 ICP6 IC20 IC10
  526. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  527. * IC15 TRIP QUAP CUBP TETP PRIP TIMO JOI2 JOI3 JOT3 JOI4
  528. & , 99, 99, 99, 99, 99, 99, 21, 99, 99, 99, 99
  529. * JOI6 JOI8 LISC TRIH DST LIC4 CERC TUYO LSE2 LITU HYT3
  530. & , 99, 99, 99, 99, 21, 99, 21, 99, 99, 99, 99
  531. * HYQ4 HYT4 HYP6 HYC8 TRIS QUAS POIS FOR3 JOP3 JOP6 JOP8
  532. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  533. * POL3 POL4 POL5 POL6 POL7 POL8 POL9 PO10 PO11 PO12 PO13
  534. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  535. * PO14 BAR3 BAEX LIA2 QUAH CUBH ROT3 SEF2 TRF3 QUF4 CUF8
  536. & , 99, 21, 99, 99, 99, 99, 99, 99, 99, 99, 99
  537. * PRF6 TEF4 PYF5 MSE3 MTR6 MQU9 MC27 MP18 MT10 MP14 SEF3
  538. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  539. * TRF7 QUF9 CF27 PF21 TF15 PF19 SEG6 TR21 QU36 C216 P126
  540. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  541. * TE56 PY91 TRH6
  542. & , 99, 99, 99),MELE
  543. C
  544. 99 CONTINUE
  545. SEGSUP xMATRI
  546. IRIGEL(4,ISOUS)=0
  547. MOTERR(1:4)=NOMTP(MELE)
  548. MOTERR(5:12)='KCEN'
  549. CALL ERREUR(86)
  550. GOTO 9990
  551. C_______________________________________________________________________
  552. C
  553. C MASSIF
  554. C_______________________________________________________________________
  555. C
  556. 11 CONTINUE
  557. CALL KCENT3 (IPMAIL,NDDL,LRE,NBPGAU,IPMINT,MELE,MFR,IVAMAT,
  558. &IVACAR,NMATT,IPMATR,VROT,IIPDPG)
  559. GOTO 510
  560. C_______________________________________________________________________
  561. C
  562. C BARRE, POUTRE, POUTRE DE TIMOSCHENKO, COQUE, CERC
  563. C_______________________________________________________________________
  564. C
  565. 21 CONTINUE
  566. CALL KCENT2(IPMAIL,LRE,LW,MELE,IVAMAT,NMATT,IVACAR,NCARR,
  567. &IVECT,ISOUS,NBPGAU,IPMINT,IPMIN1,NDDL,MATE,
  568. &CMATE,LHOTRA,IPMATR,VROT,IIPDPG)
  569. GOTO 510
  570. C_______________________________________________________________________
  571. C
  572. C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE IA
  573. C_______________________________________________________________________
  574. C
  575. 510 CONTINUE
  576. SEGDES,MINTE
  577. SEGDES MELEME
  578. SEGDES IMODEL
  579. C
  580. IF (ISUP.EQ.1) THEN
  581. CALL DTMVAL(IVAMAT,3)
  582. CALL DTMVAL(IVACAR,3)
  583. ELSE
  584. CALL DTMVAL(IVAMAT,1)
  585. CALL DTMVAL(IVACAR,1)
  586. ENDIF
  587. C
  588. NOMID=MOCARA
  589. IF (MOCARA.NE.0) SEGSUP NOMID
  590. NOMID=MOMATR
  591. SEGSUP NOMID
  592. NOMID=MOFORC
  593. if(lsupfo)SEGSUP NOMID
  594. NOMID=MODEPL
  595. if(lsupdp)SEGSUP NOMID
  596. C
  597. C ERREUR DANS LES S-P MASSE2 ,MASSE3 ,MASSE4
  598. C
  599. IF (IERR.NE.0) GOTO 9997
  600.  
  601. 500 CONTINUE
  602.  
  603. IRET = 1
  604. SEGDES MRIGID
  605. IPRIG = MRIGID
  606. GOTO 666
  607. C
  608. C ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  609. C
  610. 9990 CONTINUE
  611. IRET = 0
  612.  
  613. IF (ISUP.EQ.1) THEN
  614. CALL DTMVAL(IVAMAT,3)
  615. CALL DTMVAL(IVACAR,3)
  616. ELSE
  617. CALL DTMVAL(IVAMAT,1)
  618. CALL DTMVAL(IVACAR,1)
  619. ENDIF
  620. C
  621. NOMID=MOMATR
  622. IF (MOMATR.NE.0) SEGSUP NOMID
  623. NOMID=MOCARA
  624. IF (MOCARA.NE.0) SEGSUP NOMID
  625. NOMID=MOFORC
  626. if(lsupfo)SEGSUP NOMID
  627. NOMID=MODEPL
  628. if(lsupdp)SEGSUP NOMID
  629. C
  630. 9996 CONTINUE
  631. SEGDES MELEME
  632. SEGDES MINTE
  633. SEGDES IMODEL
  634. C
  635. 9997 CONTINUE
  636. SEGSUP MRIGID
  637. IPRIG = 0
  638. C
  639. 666 CONTINUE
  640. SEGDES,MMODEL
  641.  
  642. RETURN
  643. END
  644.  
  645.  
  646.  
  647.  
  648.  
  649.  
  650.  
  651.  
  652.  

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