Télécharger keule1.eso

Retour à la liste

Numérotation des lignes :

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

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