Télécharger gyro2.eso

Retour à la liste

Numérotation des lignes :

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

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