Télécharger gyro2.eso

Retour à la liste

Numérotation des lignes :

  1. C GYRO2 SOURCE PV 17/10/03 21:15:37 9581
  2.  
  3. SUBROUTINE GYRO2 (IPMODL,IPCHE1, IPRIG)
  4. *
  5. *_______________________________________________________________________
  6. *
  7. * appelé par GYROS
  8. *
  9. * Creation d'une matrice de couplage gyroscopique
  10. * dans le repère inertiel ou fixe (éléments POUTR, TIMO, TUYAU)
  11. *
  12. * entrees :
  13. * ========
  14. * ipmodl pointeur sur un mmodel
  15. * ipche1 pointeur sur un mchaml de caracteristiques
  16. *
  17. * sorties :
  18. * =========
  19. * iprig pointeur sur la matrice d'amortissement construite
  20. * =0 sinon en cas d'erreur (et IERR non nul)
  21. *
  22. *_______________________________________________________________________
  23.  
  24. IMPLICIT INTEGER(I-N)
  25. IMPLICIT REAL*8(A-H,O-Z)
  26.  
  27. -INC CCOPTIO
  28. -INC CCHAMP
  29. -INC CCGEOME
  30. -INC CCREEL
  31.  
  32. -INC SMRIGID
  33. -INC SMCHAML
  34. -INC SMELEME
  35. -INC SMCOORD
  36. -INC SMINTE
  37. -INC SMMODEL
  38.  
  39. INTEGER oooval
  40.  
  41. SEGMENT NOTYPE
  42. CHARACTER*16 TYPE(NBTYPE)
  43. ENDSEGMENT
  44.  
  45. SEGMENT MPTVAL
  46. INTEGER IPOS(NS),NSOF(NS)
  47. INTEGER IVAL(NCOSOU)
  48. CHARACTER*16 TYVAL(NCOSOU)
  49. ENDSEGMENT
  50.  
  51. CHARACTER*8 CMATE
  52. CHARACTER*(NCONCH) CONM
  53.  
  54. PARAMETER ( INTYP = 4 )
  55.  
  56. PARAMETER (NINF=3)
  57. INTEGER INFOS(NINF)
  58. LOGICAL lsupde,lsupfo
  59.  
  60. IPRIG = 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 COUPLAGE GYROSCOPIQUE
  69. C
  70. NRIGEL = 0
  71. SEGINI,MRIGID
  72. MTYMAT = 'AMORTISS'
  73. IFORIG = IFOMOD
  74. * IFORIG = IFOUR
  75. ICHOLE = 0
  76. IMGEO1 = 0
  77. IMGEO2 = 0
  78. ISUPEQ = 0
  79. C
  80. C_______________________________________________________________________
  81. C
  82. C DEBUT DE LA BOUCLE SUR LES DIFFERENT MODELES ELEMENTAIRES
  83. C_______________________________________________________________________
  84. C
  85. DO 500 ISOUS=1,NSOUS
  86. C
  87. IMODEL = KMODEL(ISOUS)
  88. SEGACT,IMODEL
  89.  
  90. C- Initialisations
  91. IPMINT = 0
  92.  
  93. MOMATR = 0
  94. MOCARA = 0
  95. MOTYPM = 0
  96. MOTYPC = 0
  97. ISUPM = 0
  98. ISUPC = 0
  99.  
  100. MODEPL = 0
  101. MOFORC = 0
  102. lsupde = .false.
  103. lsupfo = .false.
  104.  
  105. IDESCR = 0
  106.  
  107. C- Recuperation d'informations sur le maillage elementaire
  108. IIPDPG = imodel.IPDPGE
  109. IIPDPG = IPTPOI(IIPDPG)
  110. IPT1 = imodel.IMAMOD
  111. SEGACT,IPT1
  112. NBNOE1 = IPT1.NUM(/1)
  113. NBELE1 = IPT1.NUM(/2)
  114.  
  115. C- Quelques informations sur le modele
  116. CONM = CONMOD
  117. CMATE = CMATEE
  118. MATE = IMATEE
  119. c* INAT = INATUU
  120. C- Creation du tableau INFOS
  121. iret = 1
  122. CALL IDENT(IPT1,CONM,IPCHE1,0,INFOS,iret)
  123. IF (iret.EQ.0) GOTO 599
  124.  
  125. C- Recuperation d'informations sur l'element fini
  126. MELE = NEFMOD
  127. C
  128. NPINT = 1
  129. IF (INFMOD(/1).NE.0) NPINT = INFMOD(1)
  130. C-- Support des champs
  131. IPLAZ = 4
  132. IF (NPINT.EQ.12345) IPLAZ = 1
  133.  
  134. MFR = INFELE(13)
  135. LRE = INFELE(9)
  136. LW = INFELE(7)
  137. LHOOK = INFELE(10)
  138. NDDL = INFELE(15)
  139. c* IELE = INFELE(14)
  140. c* ICARA = INFELE(5)
  141. IPMINT = INFMOD(2+IPLAZ)
  142. c* IPMINT = INFELE(11)
  143. IPMIN1 = INFMOD(8)
  144. IPPORE = 0
  145. IF (MFR.EQ.33) IPPORE = NBNOE1
  146. C
  147. C- RECHERCHE DES NOMS D'INCONNUES ET DES DUAUX
  148. if (lnomid(1).ne.0) then
  149. MODEPL =lnomid(1)
  150. else
  151. lsupde = .true.
  152. CALL IDPRIM(IMODEL,MFR,MODEPL,NDEPL,ndum)
  153. endif
  154. nomid = MODEPL
  155. SEGACT,nomid
  156. NDEPL = lesobl(/2)
  157. c* ndum = lesfac(/2)
  158.  
  159. IF (lnomid(2).ne.0) then
  160. MOFORC = lnomid(2)
  161. ELSE
  162. lsupfo = .true.
  163. CALL IDDUAL(IMODEL,MFR,MOFORC,NFORC,NDUM)
  164. ENDIF
  165. nomid = MOFORC
  166. SEGACT,nomid
  167. NFORC = lesobl(/2)
  168. c* ndum=lesfac(/2)
  169. C
  170. IF (NDEPL.EQ.0.OR.NFORC.EQ.0.OR.NDEPL.NE.NFORC) THEN
  171. CALL ERREUR(5)
  172. GOTO 598
  173. ENDIF
  174. C
  175. C- REMPLISSAGE DU SEGMENT DESCRIPTEUR
  176. NLIGRP = LRE
  177. NLIGRD = LRE
  178. SEGINI,DESCR
  179.  
  180. NCOMP = NDEPL
  181. NBNNS = NBNOE1
  182. IF (MFR.EQ.33) NCOMP = NDEPL-1
  183. IF (IFOUR.EQ.-3) THEN
  184. NCOMP = NDEPL-3
  185. ENDIF
  186. c* ? IF (MFR.EQ.19.OR.MFR.EQ.21) NBNNS = NBNOE1/2
  187. IDDL = 1
  188. DO 1004 INOEUD=1,NBNNS
  189. DO 1005 ICOMP=1,NCOMP
  190. NOMID=MODEPL
  191. LISINC(IDDL)=LESOBL(ICOMP)
  192. NOMID=MOFORC
  193. LISDUA(IDDL)=LESOBL(ICOMP)
  194. NOELEP(IDDL)=INOEUD
  195. NOELED(IDDL)=INOEUD
  196. IDDL=IDDL+1
  197. 1005 CONTINUE
  198. 1004 CONTINUE
  199. *
  200. SEGDES,DESCR
  201. IDESCR = DESCR
  202.  
  203. C- Recuperation des noms de composantes MATERIAU
  204. nbrobl = 0
  205. nbrfac = 0
  206. nomid = 0
  207. notype = 0
  208. LHOTRA = 0
  209. C
  210. C rho dans les cas poutre,tuyau
  211. IF (MFR.EQ.7.OR.MFR.EQ.13) THEN
  212. IF (CMATE.NE.'SECTION') THEN
  213. nbrobl = 1
  214. SEGINI,nomid
  215. lesobl(1)='RHO '
  216. nbtype = 1
  217. SEGINI,notype
  218. type(1) = 'REAL*8'
  219. ELSE
  220. LHOTRA = LHOOK
  221. nbrobl=2
  222. SEGINI,nomid
  223. lesobl(1)='MODS'
  224. lesobl(2)='MATS'
  225. nbtype = 2
  226. SEGINI,notype
  227. type(1) = 'POINTEURMMODEL'
  228. type(2) = 'POINTEURMCHAML'
  229. ENDIF
  230. ENDIF
  231. MOMATR = nomid
  232. MOTYPM = notype
  233. NMATR = nbrobl
  234. NMATF = nbrfac
  235. NMATT = NMATR+NMATF
  236. C-- Verification du support des composantes recherchees
  237. IF (MOMATR.NE.0) THEN
  238. CALL QUESUQ(IMODEL,IPCHE1,INTYP,0,MOMATR,IPLAZ,ISUPM,iret)
  239. IF (ISUPM.GT.1) GOTO 597
  240. ENDIF
  241.  
  242. C- Recuperation des noms de composantes CARACTERISTIQUES
  243. nbrobl = 0
  244. nbrfac = 0
  245. nomid = 0
  246. notype = 0
  247. IVECT = 0
  248. * caracteristiques pour les poutres
  249. IF (MFR.EQ.7 ) THEN
  250. IF (CMATE.EQ.'SECTION') THEN
  251. nbrfac = 2
  252. SEGINI,nomid
  253. lesfac(1) = 'OMEG'
  254. lesfac(2) = 'VECT'
  255. IVECT = 1
  256. *
  257. nbtype = 2
  258. SEGINI,notype
  259. type(1) = 'REAL*8'
  260. type(2) = 'POINTEURPOINT '
  261. ELSE
  262. nbrobl = 4
  263. nbrfac = 4
  264. SEGINI,nomid
  265. lesobl(1) = 'TORS'
  266. lesobl(2) = 'INRY'
  267. lesobl(3) = 'INRZ'
  268. lesobl(4) = 'SECT'
  269. lesfac(1) = 'SECY'
  270. lesfac(2) = 'SECZ'
  271. lesfac(3) = 'OMEG'
  272. lesfac(4) = 'VECT'
  273. IVECT = 1
  274. *
  275. nbtype = 8
  276. SEGINI,notype
  277. type(1) = 'REAL*8'
  278. type(2) = 'REAL*8'
  279. type(3) = 'REAL*8'
  280. type(4) = 'REAL*8'
  281. type(5) = 'REAL*8'
  282. type(6) = 'REAL*8'
  283. type(7) = 'REAL*8'
  284. type(8) = 'POINTEURPOINT '
  285. ENDIF
  286. * caracteristiques pour les tuyaux
  287. ELSE IF (MFR.EQ.13) THEN
  288. nbrobl = 2
  289. nbrfac = 3
  290. SEGINI,nomid
  291. lesobl(1) = 'EPAI'
  292. lesobl(2) = 'RAYO'
  293. lesfac(1) = 'RACO'
  294. lesfac(2) = 'OMEG'
  295. lesfac(3) = 'VECT'
  296. IVECT = 1
  297. *
  298. nbtype = 5
  299. SEGINI,notype
  300. type(1) = 'REAL*8'
  301. type(2) = 'REAL*8'
  302. type(3) = 'REAL*8'
  303. type(4) = 'REAL*8'
  304. type(5) = 'POINTEURPOINT '
  305. ENDIF
  306.  
  307. MOCARA = nomid
  308. MOTYPC = notype
  309. NCARA = nbrobl
  310. NCARF = nbrfac
  311. NCARR = NCARA+NCARF
  312.  
  313. C--- Verification du support des composantes recherchées
  314. IF (MOCARA.NE.0) THEN
  315. CALL QUESUQ(IMODEL,IPCHE1,INTYP,0,MOCARA,IPLAZ,ISUPC,iret)
  316. IF (ISUPC.GT.1) GOTO 597
  317. ENDIF
  318. C
  319. C- Activation du segment MINTE
  320. MINTE = IPMINT
  321. SEGACT,MINTE
  322. NBPGAU = POIGAU(/1)
  323. C
  324. C- Partionnement si necessaire de la matrice d'amortissement
  325. C- determinant ainsi le nombre d'objets elementaires de MRIGID
  326. LTRK = oooval(1,4)
  327. IF (LTRK.EQ.0) LTRK = oooval(1,1)
  328. * Ajout a la taille en mots de la matrice des infos du segment
  329. LSEG = LRE*LRE*NBELE1 + 16
  330. NBLPRT = (LSEG-1)/LTRK + 1
  331. NBLMAX = (NBELE1-1)/NBLPRT + 1
  332. nblprt = (NBELE1-1)/NBLMAX + 1
  333. c* write(ioimp,*) ' gyro2 : nblprt nblmax = ',nblprt,nblmax,nbele1
  334.  
  335. C-- Ajout de la matrice de couplage GYROSCOPIQUE a la matrice globale
  336. NRIGE0 = IRIGEL(/2)
  337. NRIGEL = NRIGE0 + nblprt
  338. SEGADJ,MRIGID
  339.  
  340. descr = IDESCR
  341. meleme = IPT1
  342. nbnn = NBNOE1
  343. nbelem = NBELE1
  344. nbsous = 0
  345. nbref = 0
  346.  
  347. * Boucle sur les PARTITIONS elementaires de la matrice
  348. *------------------------------------------------------
  349. DO 5000 irige = 1, nblprt
  350.  
  351. IF (nblprt.GT.1) THEN
  352. C-- Partitionnement du maillage support de la matrice elementaire
  353. C- (IPT1 peut etre desactive suite a l'appel a KOMCHA !)
  354. SEGACT,IPT1
  355. ielem = (irige-1)*NBLMAX
  356. nbelem = MIN(NBLMAX,NBELE1-ielem)
  357. * write(ioimp,*) ' creation segment ',nbnn,nbelem
  358. SEGINI,meleme
  359. itypel = IPT1.itypel
  360. DO ielt = 1, nbelem
  361. jelt = ielt + ielem
  362. DO inoe = 1, nbnn
  363. num(inoe,ielt) = IPT1.NUM(inoe,jelt)
  364. ENDDO
  365. icolor(ielt) = IPT1.ICOLOR(jelt)
  366. ENDDO
  367. C-- Recopie du descripteur
  368. des1 = IDESCR
  369. SEGINI,descr=des1
  370. SEGDES,descr
  371. ENDIF
  372. C* Voir le cas IFOUR.EQ.-3
  373. ipmail = meleme
  374. ipdesc = descr
  375. ipt2 = meleme
  376.  
  377. C-- Initialisation de la matrice de rigidite elementaire (xmatri)
  378. NELRIG = nbelem
  379. SEGINI,xmatri
  380. ipmatr = xmatri
  381.  
  382. C-- Recuperation des valeurs des proprietes materiau et geometriques
  383. ivamat = 0
  384. ivacar = 0
  385. IF (MOMATR.NE.0) THEN
  386. CALL KOMCHA(IPCHE1,ipmail,CONM,MOMATR,MOTYPM,1,
  387. & INFOS,NINF,ivamat)
  388. IF (IERR.NE.0) GOTO 5099
  389. IF (ISUPM.EQ.1) THEN
  390. CALL VALCHE(ivamat,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  391. IF (IERR.NE.0) THEN
  392. ISUPM = 0
  393. GOTO 5099
  394. ENDIF
  395. ENDIF
  396. ENDIF
  397. IF (MOCARA.NE.0) THEN
  398. CALL KOMCHA(IPCHE1,ipmail,CONM,MOCARA,MOTYPC,1,
  399. & INFOS,NINF,ivacar)
  400. IF (IERR.NE.0) GOTO 5099
  401. IF (ISUPC.EQ.1) THEN
  402. CALL VALCHE(ivacar,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  403. IF (IERR.NE.0) THEN
  404. ISUPC = 0
  405. GOTO 5099
  406. ENDIF
  407. ENDIF
  408. ENDIF
  409.  
  410. C_______________________________________________________________________
  411. C
  412. C NUMERO DES ETIQUETTES :
  413. C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  414. C LES ELEMENTS SONT GROUPES COMME SUIT :
  415. C_______________________________________________________________________
  416. * CABL SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5 QUA8 QUA9
  417. GOTO ( 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  418. * RAC2 RAC3 CUB8 CU20 PRI6 PR15 LIA3 LIA4 LIA6 LIA8 MULT
  419. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  420. * TET4 TE10 PYR5 PY13 COQ3 DKT POUT LISP FAC3 FAC4 FAC6
  421. & , 99, 99, 99, 99, 99, 99, 21, 99, 99, 99, 99
  422. * FAC8 LTR3 LQU4 LCU8 LPR6 LTE4 LPY5 COQ8 TUYA TUFI COQ2
  423. & , 99, 99, 99, 99, 99, 99, 99, 99, 21, 99, 99
  424. * POI1 BARR RACO LSU2 COQ4 LISM COF3 RES2 LSU3 LSU4 LICO
  425. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  426. * COQ6 CVS2 CVS3 CVT3 CVT6 CVQ4 CVQ8 THP5 TH13 THP6 TH15
  427. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  428. * THC8 TH20 ICT3 ICQ4 ICT6 ICQ8 ICC8 ICT4 ICP6 IC20 IC10
  429. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  430. * IC15 TRIP QUAP CUBP TETP PRIP TIMO JOI2 JOI3 JOT3 JOI4
  431. & , 99, 99, 99, 99, 99, 99, 21, 99, 99, 99, 99
  432. * JOI6 JOI8 LISC TRIH DST LIC4 CERC TUYO LSE2 LITU HYT3
  433. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  434. * HYQ4 HYT4 HYP6 HYC8 TRIS QUAS POIS FOR3 JOP3 JOP6 JOP8
  435. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  436. * POL3 POL4 POL5 POL6 POL7 POL8 POL9 PO10 PO11 PO12 PO13
  437. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  438. * PO14 BAR3 BAEX LIA2 QUAH CUBH ROT3 SEF2 TRF3 QUF4 CUF8
  439. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  440. * PRF6 TEF4 PYF5 MSE3 MTR6 MQU9 MC27 MP18 MT10 MP14 SEF3
  441. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  442. * TRF7 QUF9 CF27 PF21 TF15 PF19 SEG6 TR21 QU36 C216 P126
  443. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  444. * TE56 PY91 TRH6
  445. & , 99, 99, 99),MELE
  446. C
  447. 99 CONTINUE
  448. MOTERR(1:4)=NOMTP(MELE)
  449. MOTERR(5:12)='GYROS'
  450. CALL ERREUR(86)
  451. GOTO 5099
  452. C_______________________________________________________________________
  453. C
  454. C POUTRE, POUTRE DE TIMOSCHENKO
  455. C_______________________________________________________________________
  456. C
  457. 21 CONTINUE
  458. CALL GYRO3(ipmail,LRE,LW,MELE,ivamat,NMATT,ivacar,NCARR,
  459. & IVECT,ISOUS,NBPGAU,IPMINT,IPMIN1,NDDL,MATE,
  460. & CMATE,LHOTRA,ipmatr,IIPDPG)
  461. GOTO 5100
  462. C_______________________________________________________________________
  463. C
  464. C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE IA
  465. C_______________________________________________________________________
  466. 5100 CONTINUE
  467. 5099 CONTINUE
  468. c* xmatri = ipmatr
  469. IF (nblprt.GT.1) THEN
  470. c* meleme = ipmail
  471. SEGDES,meleme
  472. ENDIF
  473. IF (ISUPM.EQ.1 .OR. nblprt.GT.1) THEN
  474. CALL DTMVAL(ivamat,3)
  475. ELSE
  476. CALL DTMVAL(ivamat,1)
  477. ENDIF
  478. IF (ISUPC.EQ.1 .OR. nblprt.GT.1) THEN
  479. CALL DTMVAL(ivacar,3)
  480. ELSE
  481. CALL DTMVAL(ivacar,1)
  482. ENDIF
  483.  
  484. C- Sortie prematuree en cas d'erreur
  485. IF (IERR.NE.0) GOTO 596
  486.  
  487. C- Stockage de la matrice
  488. jrige = NRIGE0 + irige
  489. COERIG(jrige) = 1.
  490. IRIGEL(1,jrige) = ipt2
  491. IRIGEL(2,jrige) = 0
  492. IRIGEL(3,jrige) = ipdesc
  493. IRIGEL(4,jrige) = ipmatr
  494. IRIGEL(5,jrige) = NIFOUR
  495. IRIGEL(6,jrige) = 0
  496. C-- Matrice antisymetrique
  497. IRIGEL(7,jrige) = 1
  498. xmatri.symre = 1
  499. SEGDES,xmatri
  500. IRIGEL(8,jrige) = 0
  501.  
  502. 5000 CONTINUE
  503. C- Fin de la boucle sur les partitions
  504.  
  505. 596 CONTINUE
  506. c* MINTE = IPMINT
  507. SEGDES,MINTE
  508. 597 CONTINUE
  509. IF (MOMATR.NE.0) THEN
  510. nomid = MOMATR
  511. SEGSUP,nomid
  512. notype = MOTYPM
  513. SEGSUP,notype
  514. ENDIF
  515. IF (MOCARA.NE.0) THEN
  516. nomid = MOCARA
  517. SEGSUP,nomid
  518. notype = MOTYPC
  519. SEGSUP,notype
  520. ENDIF
  521. 598 CONTINUE
  522. NOMID = MODEPL
  523. SEGDES,NOMID
  524. IF (lsupde) SEGSUP,NOMID
  525. NOMID = MOFORC
  526. SEGDES,NOMID
  527. IF (lsupfo) SEGSUP,NOMID
  528. 599 CONTINUE
  529. SEGDES,IPT1
  530. SEGDES,IMODEL
  531.  
  532. C- Sortie prematuree en cas d'erreur
  533. IF (IERR.NE.0) GOTO 999
  534.  
  535. 500 CONTINUE
  536. C- Fin de la boucle sur les modeles elementaires
  537.  
  538. 999 CONTINUE
  539. IF (IERR.NE.0) THEN
  540. SEGSUP,MRIGID
  541. IPRIG = 0
  542. ELSE
  543. SEGDES,MRIGID
  544. IPRIG = MRIGID
  545. ENDIF
  546. SEGDES,MMODEL
  547.  
  548. RETURN
  549. END
  550.  
  551.  
  552.  

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