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

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