Télécharger corio1.eso

Retour à la liste

Numérotation des lignes :

  1. C CORIO1 SOURCE PV 17/10/03 21:15:14 9581
  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 = imodel.IPDPGE
  154. IIPDPG = IPTPOI(IIPDPG)
  155. CONM = CONMOD
  156. CMATE = CMATEE
  157. MATE = IMATEE
  158. c* INAT = INATUU
  159. c- Tableau infos
  160. iret = 1
  161. CALL IDENT(IPT1,CONM,IPCHE1,0, INFOS,iret)
  162. IF (iret.EQ.0) GOTO 599
  163.  
  164. C- Recuperation d'informations sur l'element fini
  165. MELE = NEFMOD
  166.  
  167. NPINT = 1
  168. IF (INFMOD(/1).NE.0) NPINT = INFMOD(1)
  169. C support des champs
  170. IPLAZ = 4
  171. IF (NPINT.EQ.12345) IPLAZ = 1
  172.  
  173. MFR =INFELE(13)
  174. LRE = INFELE(9)
  175. NDDL = INFELE(15)
  176. IF (IFOUR.EQ.1) THEN
  177. LRE = 2*LRE
  178. NDDL = 2*NDDL
  179. ENDIF
  180. LW = INFELE(7)
  181. LHOOK = INFELE(10)
  182. IELE = INFELE(14)
  183. IPMINT = INFMOD(2+IPLAZ)
  184. C* IPMINT = INFELE(11)
  185. IPMIN1 = INFMOD(8)
  186. C* ICARA = INFELE(5)
  187. IPPORE = 0
  188. IF (MFR.EQ.33) IPPORE = NBNOE1
  189. C
  190. C INITIALISATION DE MINTE
  191. MINTE = IPMINT
  192. SEGACT,MINTE
  193. NBPGAU = POIGAU(/1)
  194. *
  195. C- RECHERCHE DES NOMS D'INCONNUES ET DES DUAUX
  196. C-----------------------------------------------------------------------
  197. if (lnomid(1).ne.0) then
  198. MODEPL = lnomid(1)
  199. else
  200. lsupde=.true.
  201. CALL IDPRIM(IMODEL,MFR,MODEPL,NDEPL,NDUM)
  202. endif
  203. nomid = MODEPL
  204. SEGACT,nomid
  205. ndepl = lesobl(/2)
  206. c* ndum=lesfac(/2)
  207.  
  208. if (lnomid(2).ne.0) then
  209. MOFORC = lnomid(2)
  210. else
  211. CALL IDDUAL(IMODEL,MFR,MOFORC,NFORC,NDUM)
  212. lsupfo=.true.
  213. endif
  214. nomid = MOFORC
  215. SEGACT,nomid
  216. nforc=lesobl(/2)
  217. c* ndum=lesfac(/2)
  218. C
  219. IF (NDEPL.EQ.0.OR.NFORC.EQ.0.OR.NDEPL.NE.NFORC) THEN
  220. CALL ERREUR(5)
  221. GOTO 598
  222. ENDIF
  223. C
  224. C REMPLISSAGE DU SEGMENT DESCRIPTEUR
  225. C-------------------------------------
  226. NLIGRP = LRE
  227. NLIGRD = LRE
  228. SEGINI,DESCR
  229. IDESCR = DESCR
  230. C
  231. NCOMP = NDEPL
  232. IF (MFR.EQ.33) NCOMP = NDEPL-1
  233. NBNNS = NBNOE1
  234. IF (MFR.EQ.19.OR.MFR.EQ.21) NBNNS = NBNOE1/2
  235.  
  236. IDDL=1
  237. DO 1004 inoe =1, NBNNS
  238. DO 1005 ICOMP=1,NCOMP
  239. IF (IFOUR.NE.1) THEN
  240. NOMID=MODEPL
  241. LISINC(IDDL)=LESOBL(ICOMP)
  242. NOMID=MOFORC
  243. LISDUA(IDDL)=LESOBL(ICOMP)
  244. NOELEP(IDDL) = inoe
  245. NOELED(IDDL) = inoe
  246. ELSE
  247. NOMID=MODEPL
  248. I = 2*IDDL
  249. LISINC(I-1)=LESOBL(ICOMP)
  250. IF (LESOBL(ICOMP).EQ.'UR ') THEN
  251. LISINC(I)='IUR '
  252. ELSEIF (LESOBL(ICOMP).EQ.'UZ ') THEN
  253. LISINC(I)='IUZ '
  254. ELSEIF (LESOBL(ICOMP).EQ.'UT ') THEN
  255. LISINC(I)='IUT '
  256. ELSEIF (LESOBL(ICOMP).EQ.'RT ') THEN
  257. LISINC(I)='IRT '
  258. ENDIF
  259. NOMID=MOFORC
  260. LISDUA(I-1)=LESOBL(ICOMP)
  261. IF (LESOBL(ICOMP).EQ.'FR ') THEN
  262. LISDUA(I)='IFR '
  263. ELSEIF (LESOBL(ICOMP).EQ.'FZ ') THEN
  264. LISDUA(I)='IFZ '
  265. ELSEIF (LESOBL(ICOMP).EQ.'FT ') THEN
  266. LISDUA(I)='IFT '
  267. ELSEIF (LESOBL(ICOMP).EQ.'MT ') THEN
  268. LISDUA(I)='IMT '
  269. ENDIF
  270. NOELEP(I-1) = inoe
  271. NOELED(I-1) = inoe
  272. NOELEP(I) = inoe
  273. NOELED(I) = inoe
  274. ENDIF
  275. IDDL=IDDL+1
  276. 1005 CONTINUE
  277. 1004 CONTINUE
  278.  
  279. SEGDES,DESCR
  280. IDESCR = DESCR
  281. C
  282. C- Recuperation des composantes MATERIAU
  283. C-----------------------------------------------------------------------
  284. NBROBL = 0
  285. NBRFAC = 0
  286. nomid = 0
  287. notype = 0
  288. LHOTRA = 0
  289. *
  290. * rho dans les cas poutre,tuyau, massif, coque
  291. *
  292. IF (MFR.EQ.1.OR.MFR.EQ.27.OR.MFR.EQ.7.OR.MFR.EQ.13.OR.
  293. & MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  294. *
  295. IF (CMATE.NE.'SECTION') THEN
  296. NBROBL = 1
  297. SEGINI,nomid
  298. LESOBL(1)='RHO '
  299. NBTYPE = 1
  300. SEGINI NOTYPE
  301. TYPE(1)='REAL*8'
  302. ELSE
  303. LHOTRA=LHOOK
  304. NBROBL=2
  305. SEGINI,nomid
  306. LESOBL(1)='MODS'
  307. LESOBL(2)='MATS'
  308. NBTYPE=2
  309. SEGINI NOTYPE
  310. TYPE(1) = 'POINTEURMMODEL'
  311. TYPE(2) = 'POINTEURMCHAML'
  312. ENDIF
  313. ENDIF
  314. C
  315. MOMATR = nomid
  316. MOTYPM = notype
  317. NMATR = NBROBL
  318. NMATF = NBRFAC
  319. NMATT = NMATR+NMATF
  320. *
  321. * verification du support des composantes recherchees
  322. *
  323. IF (MOMATR.NE.0) THEN
  324. CALL QUESUQ(IMODEL,IPCHE1,4,0,MOMATR,IPLAZ,ISUPM,iret)
  325. IF (ISUPM.GT.1) GOTO 597
  326. ENDIF
  327. *
  328. C- Recuperation des composantes CARACTERISTIQUES
  329. C-----------------------------------------------------------------------
  330. NBROBL = 0
  331. NBRFAC = 0
  332. nomid = 0
  333. notype = 0
  334. IVECT = 0
  335. *
  336. * caracteristiques pour les poutres
  337. IF (MFR.EQ.7 ) THEN
  338. IF (CMATE.EQ.'SECTION') THEN
  339. NBRFAC=2
  340. SEGINI NOMID
  341. LESFAC(1)='OMEG'
  342. LESFAC(2)='VECT'
  343. IVECT=1
  344. *
  345. NBTYPE=2
  346. SEGINI NOTYPE
  347. TYPE(1)='REAL*8'
  348. TYPE(2)='POINTEURPOINT '
  349. *
  350. ELSE
  351. NBROBL=4
  352. NBRFAC=4
  353. SEGINI NOMID
  354. LESOBL(1)='TORS'
  355. LESOBL(2)='INRY'
  356. LESOBL(3)='INRZ'
  357. LESOBL(4)='SECT'
  358. LESFAC(1)='SECY'
  359. LESFAC(2)='SECZ'
  360. LESFAC(3)='OMEG'
  361. LESFAC(4)='VECT'
  362. IVECT=1
  363. *
  364. NBTYPE=8
  365. SEGINI NOTYPE
  366. TYPE(1)='REAL*8'
  367. TYPE(2)='REAL*8'
  368. TYPE(3)='REAL*8'
  369. TYPE(4)='REAL*8'
  370. TYPE(5)='REAL*8'
  371. TYPE(6)='REAL*8'
  372. TYPE(7)='REAL*8'
  373. TYPE(8)='POINTEURPOINT '
  374. ENDIF
  375. *
  376. * caracteristiques pour les tuyaux
  377. ELSE IF (MFR.EQ.13) THEN
  378. NBROBL=2
  379. NBRFAC=3
  380. SEGINI NOMID
  381. LESOBL(1)='EPAI'
  382. LESOBL(2)='RAYO'
  383. LESFAC(1)='RACO'
  384. LESFAC(2)='OMEG'
  385. LESFAC(3)='VECT'
  386. IVECT=1
  387. *
  388. NBTYPE=5
  389. SEGINI NOTYPE
  390. TYPE(1)='REAL*8'
  391. TYPE(2)='REAL*8'
  392. TYPE(3)='REAL*8'
  393. TYPE(4)='REAL*8'
  394. TYPE(5)='POINTEURPOINT '
  395. *
  396. * caracteristiques pour les barres
  397. ELSE IF (MFR.EQ.27) THEN
  398. NBROBL=1
  399. SEGINI NOMID
  400. LESOBL(1)='SECT'
  401. *
  402. NBTYPE=1
  403. SEGINI NOTYPE
  404. TYPE(1)='REAL*8'
  405. *
  406. * epaisseur et excentrement dans le cas des coques
  407. ELSE IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  408. NBROBL=1
  409. NBRFAC=1
  410. SEGINI NOMID
  411. LESOBL(1)='EPAI'
  412. LESFAC(1)='EXCE'
  413. *
  414. NBTYPE=1
  415. SEGINI NOTYPE
  416. TYPE(1)='REAL*8'
  417. *
  418. ENDIF
  419. *
  420. MOCARA = nomid
  421. MOTYPC = notype
  422. NCARA = NBROBL
  423. NCARF = NBRFAC
  424. NCARR = NCARA+NCARF
  425.  
  426. * verification du support des composantes recherchees
  427. *
  428. IF (MOCARA.NE.0)THEN
  429. CALL QUESUQ(IMODEL,IPCHE1,4,0,MOCARA,IPLAZ,ISUPC,iret)
  430. IF (ISUPC.GT.1) GOTO 597
  431. ENDIF
  432.  
  433. C- Partionnement si necessaire de la matrice de coriolis
  434. C- determinant ainsi le nombre d'objets elementaires de MRIGID
  435. C-----------------------------------------------------------------------
  436. LTRK = oooval(1,4)
  437. IF (LTRK.EQ.0) LTRK = oooval(1,1)
  438. * Ajout a la taille en mots de la matrice des infos du segment
  439. LSEG = LRE*LRE*NBELE1 + 16
  440. NBLPRT = (LSEG-1)/LTRK + 1
  441. NBLMAX = (NBELE1-1)/NBLPRT + 1
  442. NBLPRT = (NBELE1-1)/NBLMAX + 1
  443. * write(ioimp,*) ' corio1 : nblprt nblmax = ',nblprt,nblmax,nbele1
  444.  
  445. C Ajout de la matrice de CORIOLIS a la matrice globale
  446. C-----------------------------------------------------------------------
  447. NRIGE0 = IRIGEL(/2)
  448. NRIGEL = NRIGE0 + NBLPRT
  449. SEGADJ,MRIGID
  450.  
  451. descr = IDESCR
  452. meleme = IPT1
  453. nbnn = NBNOE1
  454. nbelem = NBELE1
  455. nbsous = 0
  456. nbref = 0
  457. *
  458. * Boucle sur les PARTITIONS elementaires de la matrice
  459. ************************************************************************
  460. DO 5000 irige = 1, NBLPRT
  461.  
  462. IF (NBLPRT.GT.1) THEN
  463. C- Partitionnement du maillage support de la matrice elementaire
  464. C- (IPT1 peut etre desactive suite a l'appel a KOMCHA !)
  465. SEGACT,IPT1
  466. ielem = (irige-1)*NBLMAX
  467. nbelem = MIN(NBLMAX,NBELE1-ielem)
  468. * write(ioimp,*) ' creation segment ',nbnn,nbelem
  469. SEGINI,meleme
  470. itypel = IPT1.itypel
  471. DO ielt = 1, nbelem
  472. jelt = ielt + ielem
  473. DO inoe = 1, nbnn
  474. num(inoe,ielt) = IPT1.NUM(inoe,jelt)
  475. ENDDO
  476. icolor(ielt) = IPT1.ICOLOR(jelt)
  477. ENDDO
  478. C- Recopie du descripteur
  479. des1 = IDESCR
  480. SEGINI,descr=des1
  481. SEGDES,descr
  482. ENDIF
  483.  
  484. ipmail = meleme
  485. ipdesc = descr
  486.  
  487. C- Initialisation de la matrice de rigidite elementaire (xmatri)
  488. NELRIG = nbelem
  489. SEGINI,xmatri
  490. ipmatr = xmatri
  491.  
  492. C- Recuperation des valeurs des proprietes materiau et geometriques
  493. IVAMAT = 0
  494. IVACAR = 0
  495.  
  496. IF (MOMATR.NE.0) THEN
  497. CALL KOMCHA(IPCHE1,ipmail,CONM,MOMATR,MOTYPM,1,INFOS,3,
  498. & IVAMAT)
  499. IF (IERR.NE.0) GOTO 5100
  500. IF (ISUPM.EQ.1) THEN
  501. CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  502. IF (IERR.NE.0)THEN
  503. ISUPM = 0
  504. GOTO 5100
  505. ENDIF
  506. ENDIF
  507. ENDIF
  508. C
  509. IF (MOCARA.NE.0) THEN
  510. CALL KOMCHA(IPCHE1,ipmail,CONM,MOCARA,MOTYPC,1,INFOS,3,
  511. & IVACAR)
  512. IF (IERR.NE.0) GOTO 5100
  513. IF (ISUPC.EQ.1)THEN
  514. CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  515. IF (IERR.NE.0)THEN
  516. ISUPC = 0
  517. GOTO 5100
  518. ENDIF
  519. ENDIF
  520. ENDIF
  521.  
  522. C-----------------------------------------------------------------------
  523. C NUMERO DES ETIQUETTES :
  524. C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  525. C LES ELEMENTS SONT GROUPES COMME SUIT :
  526. C - MASSIF,LIQUIDE 'SURFACE LIBRE' ----------------------> CORIO3
  527. C - COQ3/POUTRE,DKT,COQ4,COQ8,DST ------------------> CORIO2
  528. C ET POUTRE DE TIMOSCHENKO
  529. C______________________________________________________________________
  530. * CABL SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5 QUA8 QUA9
  531. GOTO ( 99, 99, 99, 11, 99, 11, 99, 11, 99, 11, 99
  532. * RAC2 RAC3 CUB8 CU20 PRI6 PR15 LIA3 LIA4 LIA6 LIA8 MULT
  533. & , 99, 99, 11, 11, 11, 11, 99, 99, 99, 99, 99
  534. * TET4 TE10 PYR5 PY13 COQ3 DKT POUT LISP FAC3 FAC4 FAC6
  535. & , 11, 11, 11, 11, 21, 21, 21, 99, 99, 99, 99
  536. * FAC8 LTR3 LQU4 LCU8 LPR6 LTE4 LPY5 COQ8 TUYA TUFI COQ2
  537. & , 99, 99, 99, 99, 99, 99, 99, 21, 21, 99, 21
  538. * POI1 BARR RACO LSU2 COQ4 LISM COF3 RES2 LSU3 LSU4 LICO
  539. & , 99, 21, 99, 99, 21, 99, 99, 99, 99, 99, 99
  540. * COQ6 CVS2 CVS3 CVT3 CVT6 CVQ4 CVQ8 THP5 TH13 THP6 TH15
  541. & , 21, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  542. * THC8 TH20 ICT3 ICQ4 ICT6 ICQ8 ICC8 ICT4 ICP6 IC20 IC10
  543. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  544. * IC15 TRIP QUAP CUBP TETP PRIP TIMO JOI2 JOI3 JOT3 JOI4
  545. & , 99, 99, 99, 99, 99, 99, 21, 99, 99, 99, 99
  546. * JOI6 JOI8 LISC TRIH DST LIC4 CERC TUYO LSE2 LITU HYT3
  547. & , 99, 99, 99, 99, 21, 99, 99, 99, 99, 99, 99
  548. * HYQ4 HYT4 HYP6 HYC8 TRIS QUAS POIS FOR3 JOP3 JOP6 JOP8
  549. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  550. * POL3 POL4 POL5 POL6 POL7 POL8 POL9 PO10 PO11 PO12 PO13
  551. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  552. * PO14 BAR3 BAEX LIA2 QUAH CUBH ROT3 SEF2 TRF3 QUF4 CUF8
  553. & , 99, 21, 99, 99, 99, 99, 99, 99, 99, 99, 99
  554. * PRF6 TEF4 PYF5 MSE3 MTR6 MQU9 MC27 MP18 MT10 MP14 SEF3
  555. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  556. * TRF7 QUF9 CF27 PF21 TF15 PF19 SEG6 TR21 QU36 C216 P126
  557. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  558. * TE56 PY91 TRH6
  559. & , 99, 99, 99),MELE
  560. C
  561. 99 CONTINUE
  562. MOTERR(1: 4) = NOMTP(MELE)
  563. MOTERR(5:12) = 'CORI1'
  564. CALL ERREUR(86)
  565. GOTO 5100
  566.  
  567. C_______________________________________________________________________
  568. C
  569. C MASSIF
  570. C_______________________________________________________________________
  571. C
  572. 11 CONTINUE
  573. CALL CORIO3(ipmail,NDDL,LRE,NBPGAU,IPMINT,MELE,MFR,IVAMAT,
  574. & IVACAR,NMATT,ipmatr,VROT,NUMLI1,IIPDPG)
  575. C
  576. GOTO 5100
  577. C_______________________________________________________________________
  578. C
  579. C POUTRE, POUTRE DE TIMOSCHENKO, COQUE, BARRE
  580. C_______________________________________________________________________
  581. C
  582. 21 CONTINUE
  583. CALL CORIO2(ipmail,LRE,LW,MELE,IVAMAT,NMATT,IVACAR,NCARR,
  584. & IVECT,isous,NBPGAU,IPMINT,IPMIN1,NDDL,MATE,
  585. & CMATE,LHOTRA,ipmatr,VROT,NUMLI1,IIPDPG)
  586. GOTO 5100
  587. C_______________________________________________________________________
  588. C
  589. C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE IA
  590. C_______________________________________________________________________
  591. 5100 CONTINUE
  592. C
  593. IF (ISUPM.EQ.1 .OR. NBLPRT.GT.1) THEN
  594. CALL DTMVAL(IVAMAT,3)
  595. ELSE
  596. CALL DTMVAL(IVAMAT,1)
  597. ENDIF
  598. C
  599. IF (ISUPC.EQ.1 .OR. NBLPRT.GT.1) THEN
  600. CALL DTMVAL(IVACAR,3)
  601. ELSE
  602. CALL DTMVAL(IVACAR,1)
  603. ENDIF
  604. xmatri = ipmatr
  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. xmatri.symre=1
  626. ELSE
  627. IRIGEL(7,jrige) = 0
  628. xmatri.symre=0
  629. ENDIF
  630. SEGDES,xmatri
  631. IRIGEL(8,jrige) = 0
  632.  
  633. 5000 CONTINUE
  634. C- Fin de la boucle sur les partitions
  635.  
  636. 597 CONTINUE
  637. IF (MOMATR.NE.0) THEN
  638. nomid = MOMATR
  639. SEGSUP,NOMID
  640. c notype = NOTYPM
  641. notype = MOTYPM
  642. SEGSUP,notype
  643. ENDIF
  644. IF (MOCARA.NE.0) THEN
  645. nomid = MOCARA
  646. SEGSUP,NOMID
  647. c notype = NOTYPC
  648. notype = MOTYPC
  649. SEGSUP,notype
  650. ENDIF
  651. 598 CONTINUE
  652. IF (MODEPL.NE.0) THEN
  653. nomid = MODEPL
  654. SEGDES,nomid
  655. IF (lsupde) SEGSUP,nomid
  656. ENDIF
  657. IF (MOFORC.NE.0) THEN
  658. nomid = MOFORC
  659. SEGDES,nomid
  660. IF (lsupfo) SEGSUP,nomid
  661. ENDIF
  662. c* MINTE = IPMINT
  663. SEGDES,MINTE
  664. 599 CONTINUE
  665. c* IPT1 = IMAMOD
  666. SEGDES,IPT1
  667. SEGDES,IMODEL
  668.  
  669. C- En cas d'erreur
  670. IF (IERR.NE.0) GOTO 999
  671.  
  672. 500 CONTINUE
  673. C* Fin de la boucle sur les modeles elementaires
  674.  
  675. 999 CONTINUE
  676. IF (IERR.NE.0) THEN
  677. SEGSUP,MRIGID
  678. IPRIG = 0
  679. ELSE
  680. SEGDES,MRIGID
  681. IPRIG = MRIGID
  682. ENDIF
  683.  
  684. SEGDES,MMODEL
  685.  
  686. RETURN
  687. END
  688.  
  689.  
  690.  

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