Télécharger gyro2.eso

Retour à la liste

Numérotation des lignes :

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

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