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

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