Télécharger keule1.eso

Retour à la liste

Numérotation des lignes :

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

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