Télécharger corio1.eso

Retour à la liste

Numérotation des lignes :

  1. C CORIO1 SOURCE CB215821 17/01/16 21:15:15 9279
  2. SUBROUTINE CORIO1 (IPMODL,IPCHE1,IPROTA,NUMLI1,NUMLI2, IPRIG)
  3.  
  4. *_______________________________________________________________________
  5. *
  6. * appelé par CORIOL ( opérateur CORIOLIS )
  7. *
  8. * Creation d'une matrice d'amortissement de couplage gyroscopique
  9. * dans le repère tournant (éléments BARR,POUT,TIMO,TUYAU,COQUES 3D)
  10. *
  11. * entrees :
  12. * ========
  13. * ipmodl pointeur sur un mmodel
  14. * ipche1 pointeur sur un mchaml de caracteristique
  15. * iprota point = vecteur vitesse de rotation
  16. *
  17. * sorties :
  18. * =========
  19. * iprig pointeur sur la matrice construite
  20. * = 0 en cas d'erreur (IERR non nul aussi)
  21. *
  22. * Didier COMBESCURE mars 2003
  23. *_______________________________________________________________________
  24.  
  25. IMPLICIT INTEGER(I-N)
  26. IMPLICIT REAL*8(A-H,O-Z)
  27.  
  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. INTEGER oooval
  41.  
  42. SEGMENT NOTYPE
  43. CHARACTER*16 TYPE(NBTYPE)
  44. ENDSEGMENT
  45. C
  46. SEGMENT MPTVAL
  47. INTEGER IPOS(NS),NSOF(NS)
  48. INTEGER IVAL(NCOSOU)
  49. CHARACTER*16 TYVAL(NCOSOU)
  50. ENDSEGMENT
  51. C
  52. CHARACTER*8 CMATE
  53. CHARACTER*(NCONCH) CONM
  54. PARAMETER (NINF=3)
  55. INTEGER INFOS(NINF)
  56. DIMENSION VROT(3)
  57. LOGICAL lsupfo,lsupde
  58. C
  59. IPRIG = 0
  60. C
  61. c_______________________________________________________________________
  62. c
  63. c initialisation du chapeau de l objet rigidite
  64. c_______________________________________________________________________
  65. NRIGEL = 0
  66. SEGINI,MRIGID
  67. IFORIG = IFOMOD
  68. c* IFORIG = IFOUR
  69. ICHOLE = 0
  70. IMGEO1 = 0
  71. IMGEO2 = 0
  72. ISUPEQ = 0
  73. IF (NUMLI2.EQ.0) THEN
  74. MTYMAT = 'AMORTISS'
  75. ELSE
  76. MTYMAT = 'MASSE'
  77. ENDIF
  78.  
  79. C____________________________________________________________________
  80. C
  81. C LECTURE DU VECTEUR ROTATION ET MULTIPLICATION PAR 2 (pour Coriolis)
  82. C____________________________________________________________________
  83. C
  84. C Cas 3D
  85. IF (IFOUR.EQ.2) THEN
  86. IF (IPROTA.EQ.0) THEN
  87. VROT(1) =0.
  88. VROT(2) = 0.
  89. VROT(3) = 2.D0
  90. ELSE
  91. VROT(1) = 2.D0 * XCOOR((4*IPROTA) - 3)
  92. VROT(2) = 2.D0 * XCOOR((4*IPROTA) - 2)
  93. VROT(3) = 2.D0 * XCOOR((4*IPROTA) - 1)
  94. ENDIF
  95. C Cas Axi et 2D Fourier
  96. ELSE IF ((IFOUR.EQ.0) .OR. (IFOUR.EQ.1)) THEN
  97. IF (IPROTA.EQ.0) THEN
  98. VROT(1) =0.
  99. VROT(2) = 2.D0
  100. VROT(3) = 0.
  101. ELSE
  102. VROT(1) = 0.D0
  103. VROT(2) = 2.D0*XCOOR((3*IPROTA) - 1)
  104. VROT(3) = 0.D0
  105. ENDIF
  106. C Pas d'autres cas ...
  107. C --> ERREUR "Fonction indisponible pour ce mode de calcul"
  108. ELSE
  109. write(ioimp,*) 'Impossible de calculer la matrice de CORIolis'
  110. CALL ERREUR(710)
  111. GOTO 999
  112. ENDIF
  113.  
  114. C-----------------------------------------------------------------------
  115. C ACTIVATION DU MODELE
  116. C-----------------------------------------------------------------------
  117. MMODEL = IPMODL
  118. SEGACT,MMODEL
  119. NSOUS = KMODEL(/1)
  120. C
  121. C-----------------------------------------------------------------------
  122. C DEBUT DE LA BOUCLE SUR LES DIFFERENTES SOUS ZONES
  123. C-----------------------------------------------------------------------
  124. DO 500 ISOUS = 1, NSOUS
  125. C
  126. IMODEL = KMODEL(ISOUS)
  127. SEGACT,IMODEL
  128.  
  129. C- Quelques initialisations
  130. IPMINT = 0
  131.  
  132. MOMATR = 0
  133. MOCARA = 0
  134. MOTYPM = 0
  135. MOTYPC = 0
  136. ISUPM = 0
  137. ISUPC = 0
  138.  
  139. MODEPL = 0
  140. MOFORC = 0
  141. lsupde = .false.
  142. lsupfo = .false.
  143.  
  144. IDESCR = 0
  145.  
  146. C- Recuperation d'informations sur le maillage elementaire
  147. IPT1 = IMAMOD
  148. SEGACT,IPT1
  149. NBNOE1 = IPT1.NUM(/1)
  150. NBELE1 = IPT1.NUM(/2)
  151.  
  152. C- Quelques informations sur le modele
  153. IIPDPG = IPDPGE
  154. CONM = CONMOD
  155. CMATE = CMATEE
  156. MATE = IMATEE
  157. c* INAT = INATUU
  158. c- Tableau infos
  159. iret = 1
  160. CALL IDENT(IPT1,CONM,IPCHE1,0, INFOS,iret)
  161. IF (iret.EQ.0) GOTO 599
  162.  
  163. C- Recuperation d'informations sur l'element fini
  164. MELE = NEFMOD
  165.  
  166. NPINT = 1
  167. IF (INFMOD(/1).NE.0) NPINT = INFMOD(1)
  168. C support des champs
  169. IPLAZ = 4
  170. IF (NPINT.EQ.12345) IPLAZ = 1
  171.  
  172. MFR =INFELE(13)
  173. LRE = INFELE(9)
  174. NDDL = INFELE(15)
  175. IF (IFOUR.EQ.1) THEN
  176. LRE = 2*LRE
  177. NDDL = 2*NDDL
  178. ENDIF
  179. LW = INFELE(7)
  180. LHOOK = INFELE(10)
  181. IELE = INFELE(14)
  182. IPMINT = INFMOD(2+IPLAZ)
  183. C* IPMINT = INFELE(11)
  184. IPMIN1 = INFMOD(8)
  185. C* ICARA = INFELE(5)
  186. IPPORE = 0
  187. IF (MFR.EQ.33) IPPORE = NBNOE1
  188. C
  189. C INITIALISATION DE MINTE
  190. MINTE = IPMINT
  191. SEGACT,MINTE
  192. NBPGAU = POIGAU(/1)
  193. *
  194. C- RECHERCHE DES NOMS D'INCONNUES ET DES DUAUX
  195. C-----------------------------------------------------------------------
  196. if (lnomid(1).ne.0) then
  197. MODEPL = lnomid(1)
  198. else
  199. lsupde=.true.
  200. CALL IDPRIM(IMODEL,MFR,MODEPL,NDEPL,NDUM)
  201. endif
  202. nomid = MODEPL
  203. SEGACT,nomid
  204. ndepl = lesobl(/2)
  205. c* ndum=lesfac(/2)
  206.  
  207. if (lnomid(2).ne.0) then
  208. MOFORC = lnomid(2)
  209. else
  210. CALL IDDUAL(IMODEL,MFR,MOFORC,NFORC,NDUM)
  211. lsupfo=.true.
  212. endif
  213. nomid = MOFORC
  214. SEGACT,nomid
  215. nforc=lesobl(/2)
  216. c* ndum=lesfac(/2)
  217. C
  218. IF (NDEPL.EQ.0.OR.NFORC.EQ.0.OR.NDEPL.NE.NFORC) THEN
  219. CALL ERREUR(5)
  220. GOTO 598
  221. ENDIF
  222. C
  223. C REMPLISSAGE DU SEGMENT DESCRIPTEUR
  224. C-------------------------------------
  225. NLIGRP = LRE
  226. NLIGRD = LRE
  227. SEGINI,DESCR
  228. IDESCR = DESCR
  229. C
  230. NCOMP = NDEPL
  231. IF (MFR.EQ.33) NCOMP = NDEPL-1
  232. NBNNS = NBNOE1
  233. IF (MFR.EQ.19.OR.MFR.EQ.21) NBNNS = NBNOE1/2
  234.  
  235. IDDL=1
  236. DO 1004 inoe =1, NBNNS
  237. DO 1005 ICOMP=1,NCOMP
  238. IF (IFOUR.NE.1) THEN
  239. NOMID=MODEPL
  240. LISINC(IDDL)=LESOBL(ICOMP)
  241. NOMID=MOFORC
  242. LISDUA(IDDL)=LESOBL(ICOMP)
  243. NOELEP(IDDL) = inoe
  244. NOELED(IDDL) = inoe
  245. ELSE
  246. NOMID=MODEPL
  247. I = 2*IDDL
  248. LISINC(I-1)=LESOBL(ICOMP)
  249. IF (LESOBL(ICOMP).EQ.'UR ') THEN
  250. LISINC(I)='IUR '
  251. ELSEIF (LESOBL(ICOMP).EQ.'UZ ') THEN
  252. LISINC(I)='IUZ '
  253. ELSEIF (LESOBL(ICOMP).EQ.'UT ') THEN
  254. LISINC(I)='IUT '
  255. ELSEIF (LESOBL(ICOMP).EQ.'RT ') THEN
  256. LISINC(I)='IRT '
  257. ENDIF
  258. NOMID=MOFORC
  259. LISDUA(I-1)=LESOBL(ICOMP)
  260. IF (LESOBL(ICOMP).EQ.'FR ') THEN
  261. LISDUA(I)='IFR '
  262. ELSEIF (LESOBL(ICOMP).EQ.'FZ ') THEN
  263. LISDUA(I)='IFZ '
  264. ELSEIF (LESOBL(ICOMP).EQ.'FT ') THEN
  265. LISDUA(I)='IFT '
  266. ELSEIF (LESOBL(ICOMP).EQ.'MT ') THEN
  267. LISDUA(I)='IMT '
  268. ENDIF
  269. NOELEP(I-1) = inoe
  270. NOELED(I-1) = inoe
  271. NOELEP(I) = inoe
  272. NOELED(I) = inoe
  273. ENDIF
  274. IDDL=IDDL+1
  275. 1005 CONTINUE
  276. 1004 CONTINUE
  277.  
  278. SEGDES,DESCR
  279. IDESCR = DESCR
  280. C
  281. C- Recuperation des composantes MATERIAU
  282. C-----------------------------------------------------------------------
  283. NBROBL = 0
  284. NBRFAC = 0
  285. nomid = 0
  286. notype = 0
  287. LHOTRA = 0
  288. *
  289. * rho dans les cas poutre,tuyau, massif, coque
  290. *
  291. IF (MFR.EQ.1.OR.MFR.EQ.27.OR.MFR.EQ.7.OR.MFR.EQ.13.OR.
  292. & MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  293. *
  294. IF (CMATE.NE.'SECTION') THEN
  295. NBROBL = 1
  296. SEGINI,nomid
  297. LESOBL(1)='RHO '
  298. NBTYPE = 1
  299. SEGINI NOTYPE
  300. TYPE(1)='REAL*8'
  301. ELSE
  302. LHOTRA=LHOOK
  303. NBROBL=2
  304. SEGINI,nomid
  305. LESOBL(1)='MODS'
  306. LESOBL(2)='MATS'
  307. NBTYPE=2
  308. SEGINI NOTYPE
  309. TYPE(1) = 'POINTEURMMODEL'
  310. TYPE(2) = 'POINTEURMCHAML'
  311. ENDIF
  312. ENDIF
  313. C
  314. MOMATR = nomid
  315. MOTYPM = notype
  316. NMATR = NBROBL
  317. NMATF = NBRFAC
  318. NMATT = NMATR+NMATF
  319. *
  320. * verification du support des composantes recherchees
  321. *
  322. IF (MOMATR.NE.0) THEN
  323. CALL QUESUQ(IMODEL,IPCHE1,4,0,MOMATR,IPLAZ,ISUPM,iret)
  324. IF (ISUPM.GT.1) GOTO 597
  325. ENDIF
  326. *
  327. C- Recuperation des composantes CARACTERISTIQUES
  328. C-----------------------------------------------------------------------
  329. NBROBL = 0
  330. NBRFAC = 0
  331. nomid = 0
  332. notype = 0
  333. IVECT = 0
  334. *
  335. * caracteristiques pour les poutres
  336. IF (MFR.EQ.7 ) THEN
  337. IF (CMATE.EQ.'SECTION') THEN
  338. NBRFAC=2
  339. SEGINI NOMID
  340. LESFAC(1)='OMEG'
  341. LESFAC(2)='VECT'
  342. IVECT=1
  343. *
  344. NBTYPE=2
  345. SEGINI NOTYPE
  346. TYPE(1)='REAL*8'
  347. TYPE(2)='POINTEURPOINT '
  348. *
  349. ELSE
  350. NBROBL=4
  351. NBRFAC=4
  352. SEGINI NOMID
  353. LESOBL(1)='TORS'
  354. LESOBL(2)='INRY'
  355. LESOBL(3)='INRZ'
  356. LESOBL(4)='SECT'
  357. LESFAC(1)='SECY'
  358. LESFAC(2)='SECZ'
  359. LESFAC(3)='OMEG'
  360. LESFAC(4)='VECT'
  361. IVECT=1
  362. *
  363. NBTYPE=8
  364. SEGINI NOTYPE
  365. TYPE(1)='REAL*8'
  366. TYPE(2)='REAL*8'
  367. TYPE(3)='REAL*8'
  368. TYPE(4)='REAL*8'
  369. TYPE(5)='REAL*8'
  370. TYPE(6)='REAL*8'
  371. TYPE(7)='REAL*8'
  372. TYPE(8)='POINTEURPOINT '
  373. ENDIF
  374. *
  375. * caracteristiques pour les tuyaux
  376. ELSE IF (MFR.EQ.13) THEN
  377. NBROBL=2
  378. NBRFAC=3
  379. SEGINI NOMID
  380. LESOBL(1)='EPAI'
  381. LESOBL(2)='RAYO'
  382. LESFAC(1)='RACO'
  383. LESFAC(2)='OMEG'
  384. LESFAC(3)='VECT'
  385. IVECT=1
  386. *
  387. NBTYPE=5
  388. SEGINI NOTYPE
  389. TYPE(1)='REAL*8'
  390. TYPE(2)='REAL*8'
  391. TYPE(3)='REAL*8'
  392. TYPE(4)='REAL*8'
  393. TYPE(5)='POINTEURPOINT '
  394. *
  395. * caracteristiques pour les barres
  396. ELSE IF (MFR.EQ.27) THEN
  397. NBROBL=1
  398. SEGINI NOMID
  399. LESOBL(1)='SECT'
  400. *
  401. NBTYPE=1
  402. SEGINI NOTYPE
  403. TYPE(1)='REAL*8'
  404. *
  405. * epaisseur et excentrement dans le cas des coques
  406. ELSE IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  407. NBROBL=1
  408. NBRFAC=1
  409. SEGINI NOMID
  410. LESOBL(1)='EPAI'
  411. LESFAC(1)='EXCE'
  412. *
  413. NBTYPE=1
  414. SEGINI NOTYPE
  415. TYPE(1)='REAL*8'
  416. *
  417. ENDIF
  418. *
  419. MOCARA = nomid
  420. MOTYPC = notype
  421. NCARA = NBROBL
  422. NCARF = NBRFAC
  423. NCARR = NCARA+NCARF
  424.  
  425. * verification du support des composantes recherchees
  426. *
  427. IF (MOCARA.NE.0)THEN
  428. CALL QUESUQ(IMODEL,IPCHE1,4,0,MOCARA,IPLAZ,ISUPC,iret)
  429. IF (ISUPC.GT.1) GOTO 597
  430. ENDIF
  431.  
  432. C- Partionnement si necessaire de la matrice de coriolis
  433. C- determinant ainsi le nombre d'objets elementaires de MRIGID
  434. C-----------------------------------------------------------------------
  435. LTRK = oooval(1,4)
  436. IF (LTRK.EQ.0) LTRK = oooval(1,1)
  437. * Ajout a la taille en mots de la matrice des infos du segment
  438. LSEG = LRE*LRE*NBELE1 + 16
  439. NBLPRT = (LSEG-1)/LTRK + 1
  440. NBLMAX = (NBELE1-1)/NBLPRT + 1
  441. NBLPRT = (NBELE1-1)/NBLMAX + 1
  442. * write(ioimp,*) ' corio1 : nblprt nblmax = ',nblprt,nblmax,nbele1
  443.  
  444. C Ajout de la matrice de CORIOLIS a la matrice globale
  445. C-----------------------------------------------------------------------
  446. NRIGE0 = IRIGEL(/2)
  447. NRIGEL = NRIGE0 + NBLPRT
  448. SEGADJ,MRIGID
  449.  
  450. descr = IDESCR
  451. meleme = IPT1
  452. nbnn = NBNOE1
  453. nbelem = NBELE1
  454. nbsous = 0
  455. nbref = 0
  456. *
  457. * Boucle sur les PARTITIONS elementaires de la matrice
  458. ************************************************************************
  459. DO 5000 irige = 1, NBLPRT
  460.  
  461. IF (NBLPRT.GT.1) THEN
  462. C- Partitionnement du maillage support de la matrice elementaire
  463. C- (IPT1 peut etre desactive suite a l'appel a KOMCHA !)
  464. SEGACT,IPT1
  465. ielem = (irige-1)*NBLMAX
  466. nbelem = MIN(NBLMAX,NBELE1-ielem)
  467. * write(ioimp,*) ' creation segment ',nbnn,nbelem
  468. SEGINI,meleme
  469. itypel = IPT1.itypel
  470. DO ielt = 1, nbelem
  471. jelt = ielt + ielem
  472. DO inoe = 1, nbnn
  473. num(inoe,ielt) = IPT1.NUM(inoe,jelt)
  474. ENDDO
  475. icolor(ielt) = IPT1.ICOLOR(jelt)
  476. ENDDO
  477. C- Recopie du descripteur
  478. des1 = IDESCR
  479. SEGINI,descr=des1
  480. SEGDES,descr
  481. ENDIF
  482.  
  483. ipmail = meleme
  484. ipdesc = descr
  485.  
  486. C- Initialisation de la matrice de rigidite elementaire (xmatri)
  487. NELRIG = nbelem
  488. SEGINI,xmatri
  489. ipmatr = xmatri
  490.  
  491. C- Recuperation des valeurs des proprietes materiau et geometriques
  492. IVAMAT = 0
  493. IVACAR = 0
  494.  
  495. IF (MOMATR.NE.0) THEN
  496. CALL KOMCHA(IPCHE1,ipmail,CONM,MOMATR,MOTYPM,1,INFOS,3,
  497. & IVAMAT)
  498. IF (IERR.NE.0) GOTO 5100
  499. IF (ISUPM.EQ.1) THEN
  500. CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  501. IF (IERR.NE.0)THEN
  502. ISUPM = 0
  503. GOTO 5100
  504. ENDIF
  505. ENDIF
  506. ENDIF
  507. C
  508. IF (MOCARA.NE.0) THEN
  509. CALL KOMCHA(IPCHE1,ipmail,CONM,MOCARA,MOTYPC,1,INFOS,3,
  510. & IVACAR)
  511. IF (IERR.NE.0) GOTO 5100
  512. IF (ISUPC.EQ.1)THEN
  513. CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  514. IF (IERR.NE.0)THEN
  515. ISUPC = 0
  516. GOTO 5100
  517. ENDIF
  518. ENDIF
  519. ENDIF
  520.  
  521. C-----------------------------------------------------------------------
  522. C NUMERO DES ETIQUETTES :
  523. C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  524. C LES ELEMENTS SONT GROUPES COMME SUIT :
  525. C - MASSIF,LIQUIDE 'SURFACE LIBRE' ----------------------> CORIO3
  526. C - COQ3/POUTRE,DKT,COQ4,COQ8,DST ------------------> CORIO2
  527. C ET POUTRE DE TIMOSCHENKO
  528. C______________________________________________________________________
  529. * CABL SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5 QUA8 QUA9
  530. GOTO ( 99, 99, 99, 11, 99, 11, 99, 11, 99, 11, 99
  531. * RAC2 RAC3 CUB8 CU20 PRI6 PR15 LIA3 LIA4 LIA6 LIA8 MULT
  532. & , 99, 99, 11, 11, 11, 11, 99, 99, 99, 99, 99
  533. * TET4 TE10 PYR5 PY13 COQ3 DKT POUT LISP FAC3 FAC4 FAC6
  534. & , 11, 11, 11, 11, 21, 21, 21, 99, 99, 99, 99
  535. * FAC8 LTR3 LQU4 LCU8 LPR6 LTE4 LPY5 COQ8 TUYA TUFI COQ2
  536. & , 99, 99, 99, 99, 99, 99, 99, 21, 21, 99, 21
  537. * POI1 BARR RACO LSU2 COQ4 LISM COF3 RES2 LSU3 LSU4 LICO
  538. & , 99, 21, 99, 99, 21, 99, 99, 99, 99, 99, 99
  539. * COQ6 CVS2 CVS3 CVT3 CVT6 CVQ4 CVQ8 THP5 TH13 THP6 TH15
  540. & , 21, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  541. * THC8 TH20 ICT3 ICQ4 ICT6 ICQ8 ICC8 ICT4 ICP6 IC20 IC10
  542. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  543. * IC15 TRIP QUAP CUBP TETP PRIP TIMO JOI2 JOI3 JOT3 JOI4
  544. & , 99, 99, 99, 99, 99, 99, 21, 99, 99, 99, 99
  545. * JOI6 JOI8 LISC TRIH DST LIC4 CERC TUYO LSE2 LITU HYT3
  546. & , 99, 99, 99, 99, 21, 99, 99, 99, 99, 99, 99
  547. * HYQ4 HYT4 HYP6 HYC8 TRIS QUAS POIS FOR3 JOP3 JOP6 JOP8
  548. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  549. * POL3 POL4 POL5 POL6 POL7 POL8 POL9 PO10 PO11 PO12 PO13
  550. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  551. * PO14 BAR3 BAEX LIA2 QUAH CUBH ROT3 SEF2 TRF3 QUF4 CUF8
  552. & , 99, 21, 99, 99, 99, 99, 99, 99, 99, 99, 99
  553. * PRF6 TEF4 PYF5 MSE3 MTR6 MQU9 MC27 MP18 MT10 MP14 SEF3
  554. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  555. * TRF7 QUF9 CF27 PF21 TF15 PF19 SEG6 TR21 QU36 C216 P126
  556. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  557. * TE56 PY91 TRH6
  558. & , 99, 99, 99),MELE
  559. C
  560. 99 CONTINUE
  561. MOTERR(1: 4) = NOMTP(MELE)
  562. MOTERR(5:12) = 'CORI1'
  563. CALL ERREUR(86)
  564. GOTO 5100
  565.  
  566. C_______________________________________________________________________
  567. C
  568. C MASSIF
  569. C_______________________________________________________________________
  570. C
  571. 11 CONTINUE
  572. CALL CORIO3(ipmail,NDDL,LRE,NBPGAU,IPMINT,MELE,MFR,IVAMAT,
  573. & IVACAR,NMATT,ipmatr,VROT,NUMLI1,IIPDPG)
  574. C
  575. GOTO 5100
  576. C_______________________________________________________________________
  577. C
  578. C POUTRE, POUTRE DE TIMOSCHENKO, COQUE, BARRE
  579. C_______________________________________________________________________
  580. C
  581. 21 CONTINUE
  582. CALL CORIO2(ipmail,LRE,LW,MELE,IVAMAT,NMATT,IVACAR,NCARR,
  583. & IVECT,isous,NBPGAU,IPMINT,IPMIN1,NDDL,MATE,
  584. & CMATE,LHOTRA,ipmatr,VROT,NUMLI1,IIPDPG)
  585. GOTO 5100
  586. C_______________________________________________________________________
  587. C
  588. C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE IA
  589. C_______________________________________________________________________
  590. 5100 CONTINUE
  591. C
  592. IF (ISUPM.EQ.1 .OR. NBLPRT.GT.1) THEN
  593. CALL DTMVAL(IVAMAT,3)
  594. ELSE
  595. CALL DTMVAL(IVAMAT,1)
  596. ENDIF
  597. C
  598. IF (ISUPC.EQ.1 .OR. NBLPRT.GT.1) THEN
  599. CALL DTMVAL(IVACAR,3)
  600. ELSE
  601. CALL DTMVAL(IVACAR,1)
  602. ENDIF
  603. xmatri = ipmatr
  604. SEGDES,xmatri
  605. IF (NBLPRT.GT.1) THEN
  606. meleme = ipmail
  607. SEGDES,meleme
  608. ENDIF
  609.  
  610. C- Sortie prematuree en cas d'erreur
  611. IF (IERR.NE.0) GOTO 597
  612.  
  613. C- Stockage de la matrice
  614. jrige = NRIGE0 + irige
  615. COERIG(jrige) = 1.
  616. IRIGEL(1,jrige) = ipmail
  617. IRIGEL(2,jrige) = 0
  618. IRIGEL(3,jrige) = ipdesc
  619. IRIGEL(4,jrige) = ipmatr
  620. IRIGEL(5,jrige) = NIFOUR
  621. IRIGEL(6,jrige) = 0
  622. C- Matrice antisymetrique si non 'HARM'
  623. IF (NUMLI1.EQ.0) THEN
  624. IRIGEL(7,jrige) = 1
  625. ELSE
  626. IRIGEL(7,jrige) = 0
  627. ENDIF
  628. IRIGEL(8,jrige) = 0
  629.  
  630. 5000 CONTINUE
  631. C- Fin de la boucle sur les partitions
  632.  
  633. 597 CONTINUE
  634. IF (MOMATR.NE.0) THEN
  635. nomid = MOMATR
  636. SEGSUP,NOMID
  637. c notype = NOTYPM
  638. notype = MOTYPM
  639. SEGSUP,notype
  640. ENDIF
  641. IF (MOCARA.NE.0) THEN
  642. nomid = MOCARA
  643. SEGSUP,NOMID
  644. c notype = NOTYPC
  645. notype = MOTYPC
  646. SEGSUP,notype
  647. ENDIF
  648. 598 CONTINUE
  649. IF (MODEPL.NE.0) THEN
  650. nomid = MODEPL
  651. SEGDES,nomid
  652. IF (lsupde) SEGSUP,nomid
  653. ENDIF
  654. IF (MOFORC.NE.0) THEN
  655. nomid = MOFORC
  656. SEGDES,nomid
  657. IF (lsupfo) SEGSUP,nomid
  658. ENDIF
  659. c* MINTE = IPMINT
  660. SEGDES,MINTE
  661. 599 CONTINUE
  662. c* IPT1 = IMAMOD
  663. SEGDES,IPT1
  664. SEGDES,IMODEL
  665.  
  666. C- En cas d'erreur
  667. IF (IERR.NE.0) GOTO 999
  668.  
  669. 500 CONTINUE
  670. C* Fin de la boucle sur les modeles elementaires
  671.  
  672. 999 CONTINUE
  673. IF (IERR.NE.0) THEN
  674. SEGSUP,MRIGID
  675. IPRIG = 0
  676. ELSE
  677. SEGDES,MRIGID
  678. IPRIG = MRIGID
  679. ENDIF
  680.  
  681. SEGDES,MMODEL
  682.  
  683. RETURN
  684. END
  685.  
  686.  
  687.  
  688.  
  689.  
  690.  
  691.  
  692.  
  693.  
  694.  
  695.  

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