Télécharger kcent1.eso

Retour à la liste

Numérotation des lignes :

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

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