Télécharger keule1.eso

Retour à la liste

Numérotation des lignes :

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

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