Télécharger masse1.eso

Retour à la liste

Numérotation des lignes :

  1. C MASSE1 SOURCE FANDEUR 17/03/10 21:15:05 9342
  2.  
  3. SUBROUTINE MASSE1 (MODORI,IPCHE1,IPMASS,IRET,ILUMP)
  4.  
  5. *_______________________________________________________________________
  6. *
  7. * appele par masse ( opérateur masse et lump )
  8. *
  9. * entrees :
  10. * ========
  11. *
  12. * modori pointeur sur un mmodel
  13. * ipche1 pointeur sur un mchaml de caracteristique
  14. * ilump si il s'agit de l'opérateur lump
  15. *
  16. * sorties :
  17. * =========
  18. *
  19. * ipmass pointeur sur la masse construite
  20. * iret 1 si ok, 0 sinon
  21. *
  22. *_______________________________________________________________________
  23. IMPLICIT INTEGER(I-N)
  24. IMPLICIT REAL*8(A-H,O-Z)
  25.  
  26. INTEGER oooval
  27.  
  28. -INC CCOPTIO
  29. -INC CCHAMP
  30. -INC CCGEOME
  31. -INC CCREEL
  32. -INC SMRIGID
  33. -INC SMCHAML
  34. -INC SMELEME
  35. -INC SMCOORD
  36. -INC SMINTE
  37. -INC SMMODEL
  38. C
  39. SEGMENT INFO
  40. INTEGER INFELL(JG)
  41. ENDSEGMENT
  42. C
  43. SEGMENT NOTYPE
  44. C
  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. segment modsta
  55. integer pimoda(nmoda),pistat(nstat)
  56. integer ivmoda(nmoda),ivstat(nstat)
  57. endsegment
  58. C
  59. CHARACTER*8 CMATE
  60. CHARACTER*(NCONCH) CONM
  61. PARAMETER (NINF=3)
  62. INTEGER INFOS(NINF)
  63. LOGICAL BDPGE,lsupfo,lsupdp,dcmate,dcmat2
  64. C
  65. NHRM=NIFOUR
  66.  
  67. IRET = 0
  68. *
  69. * verification du lieu support du mchaml de caracteristiques
  70. *
  71. * am 5/1/95 on remplace par un appel a quesup plus
  72. * loin pour ne tester que sur les composantes ad hoc
  73. *
  74. * call quesup(ipmodl,ipche1,4,0,isup)
  75. * if(isup.gt.1) return
  76. C
  77. C ACTIVATION DU MODELE
  78. C
  79. * MODORI = Modele initial complet
  80. * IPMODL = Modele "deroule" (uniquement "MECANIQUE", "LIQUIDE" ou "POREUX")
  81. CALL PIMODL(MODORI,IPMODL)
  82. IF (IPMODL.EQ.0) RETURN
  83. * IPMODL est ACTIF en retour (nouveau pointeur pouvant etre detruit)
  84. MMODEL=IPMODL
  85. NSOUS=KMODEL(/1)
  86. C
  87. C CREATION DE L'OBJET MATRICE DE MASSE
  88. C
  89. NRIGEL=0
  90. SEGINI,MRIGID
  91. IPMASS=MRIGID
  92. MTYMAT='MASSE'
  93. IFORIG=IFOUR
  94. ICHOLE=0
  95. IMGEO1=0
  96. IMGEO2=0
  97. ISUPEQ=0
  98.  
  99. * termes croises STATIQUE et/ou MODAL
  100. nstat = 100
  101. kstat = 0
  102. nmoda = 100
  103. kmoda = 0
  104. segini modsta
  105. C_______________________________________________________________________
  106. C
  107. C DEBUT DE LA BOUCLE SUR LES DIFFERENTES SOUS ZONES
  108. C_______________________________________________________________________
  109. C
  110. isouss=0
  111. DO 500 ISOUS=1,NSOUS
  112. C
  113. C ON RECUPERE LINFORMATION GENERALES
  114. C
  115. IMODEL=KMODEL(ISOUS)
  116. SEGACT IMODEL
  117. *
  118. IIPDPG = IPDPGE
  119. IPMAIL=IMAMOD
  120. CONM =CONMOD
  121. dcmate = .false.
  122. dcmat2 = .false.
  123. C
  124. C TRAITEMENT DU MODELE
  125. C
  126. MELE=NEFMOD
  127. * Cas particulier des relations de conformites : pas de masse
  128. IF (MELE.EQ.22) GOTO 500
  129. *
  130. npint=1
  131. if (infmod(/1).ne.0) npint = infmod(1)
  132. C
  133. C NATURE DU MATERIAU
  134. C
  135. CMATE = CMATEE
  136. MATE = IMATEE
  137. INAT = INATUU
  138.  
  139. do im = 1,matmod(/2)
  140. if (matmod(im).eq.'IMPEDANCE') then
  141. dcmate =.true.
  142. if(tymode(/2).gt.0)then
  143. * detecte impedance seg2 hybride ddl
  144. if(tymode(1).eq.'LISTMOTS') dcmat2 = .true.
  145. endif
  146. endif
  147. enddo
  148. C
  149. C CREATION DU TABLEAU INFOS
  150. C
  151. IRTD=1
  152. CALL IDENT(IPMAIL,CONM,IPCHE1,0,INFOS,IRTD)
  153. IF (IRTD.EQ.0) GOTO 9996
  154.  
  155. C_______________________________________________________________________
  156. C
  157. C INFORMATION SUR L ELEMENT FINI
  158. C_______________________________________________________________________
  159. C
  160. ipt1 = ipmail
  161. segact,ipt1
  162. C mele = nefmod
  163. C Cas particulier : POI1/SEG2 et IMPEDANCE
  164. IF (dcmate) THEN
  165. if (ipt1.itypel.eq.1) mele = 45
  166. if (ipt1.itypel.eq.2) mele = 2
  167. ENDIF
  168. C
  169. isupo=4
  170. if (npint.eq.12345) isupo=1
  171. * integration aux noeuds
  172.  
  173. if(infmod(/1).lt.2+isupo)then
  174. CALL ELQUOI(MELE,0,isupo,IPINF,IMODEL)
  175. INFO=IPINF
  176. MINTE=INFELL(11)
  177. MINTE1=INFELL(12)
  178. MFR =INFELL(13)
  179. LRE =INFELL(9)
  180. LW =INFELL(7)
  181. LHOOK =INFELL(10)
  182. NDDL =INFELL(15)
  183. IELE=INFELL(14)
  184. ICARA=INFELL(5)
  185. NLIGRP = INFELL(9)
  186. NLIGRD = INFELL(9)
  187. segsup info
  188. if(mele.ne.260) segact minte
  189. * write(6,*) ' premier elquoi'
  190. * write(6,*) 'poigau',(poigau(iou),iou=1,poigau(/1))
  191. * write(6,*) ((shptot(ir,it,1),ir=1,shptot(/1)),it=1,shptot(/2))
  192. else
  193. MINTE=INFMOD(2+isupo)
  194. MINTE1=INFMOD(8)
  195. MFR =INFELE(13)
  196. LRE =INFELE(9)
  197. LW =INFELE(7)
  198. LHOOK =INFELE(10)
  199. NDDL =INFELE(15)
  200. IELE=INFELE(14)
  201. ICARA=INFELE(5)
  202. NLIGRP = INFELE(9)
  203. NLIGRD = INFELE(9)
  204. endif
  205. IPMINT=MINTE
  206. IPMIN1=MINTE1
  207. * segact minte
  208. * write(6,*) ' deuxieme elquoi'
  209. * write(6,*) 'poigau',(poigau(iou),iou=1,poigau(/1))
  210. * write(6,*) ((shptot(ir,it,1),ir=1,shptot(/1)),it=1,shptot(/2))
  211. C
  212. C INITIALISATION DE MINTE
  213. C
  214. if(mele.ne.260) then
  215. SEGACT MINTE
  216. NBPGAU=POIGAU(/1)
  217. else
  218. NBPGAU=5
  219. endif
  220. C
  221. C En cas de point support en DEFO PLAN GENE
  222. CALL INFDPG(MFR,IFOUR, BDPGE,NDPGE)
  223. NDDLGE = NDPGE
  224. IF (BDPGE) THEN
  225. IF (IIPDPG.LE.0) THEN
  226. CALL ERREUR(925)
  227. GOTO 9995
  228. ENDIF
  229. C* Cas particulier (pourquoi ?)
  230. IF (IFOUR.EQ.-3) NDDLGE = 1
  231. ENDIF
  232. C
  233. * Preparation du PARTITIONNEMENT du segment XMATRI
  234. LTRK=OOOVAL(1,4)
  235. IF (LTRK.EQ.0) LTRK=OOOVAL(1,1)
  236. IPT1=IPMAIL
  237. SEGACT,IPT1
  238. NBNN1 =IPT1.NUM(/1)
  239. NBELE1=IPT1.NUM(/2)
  240. * Ajout a la taille en mots de la matrice des infos du segment
  241. LSEG=LRE*LRE*NBELE1 + 16
  242. NBLPRT=(LSEG-1)/LTRK+1
  243. NBLMAX=(NBELE1-1)/NBLPRT+1
  244. NBLPRT=(NBELE1-1)/NBLMAX+1
  245. * write (ioimp,*) ' masse1 nblprt nblmax ',NBLPRT,NBLMAX,NBELE1
  246. NRIGEL = IRIGEL(/2) + NBLPRT
  247. SEGADJ,MRIGID
  248. IPMASS=MRIGID
  249. MELEME=IPT1
  250.  
  251. * Boucle (5000) de PARTITIONNEMENT du segment XMATRI
  252. DO 5000 IPRT = 1,NBLPRT
  253. isouss=isouss+1
  254. IF (NBLPRT.GT.1) THEN
  255. JPRT=(IPRT-1)*NBLMAX
  256. SEGACT,IPT1
  257. NBSOUS=0
  258. NBREF=0
  259. NBNN=NBNN1
  260. NBELEM=MIN(NBLMAX,NBELE1-JPRT)
  261. * write (6,*) ' creation segment ',nbnn,nbelem
  262. SEGINI,MELEME
  263. ITYPEL=IPT1.ITYPEL
  264. DO I=1,NBELEM
  265. IB=I+JPRT
  266. DO J=1,NBNN
  267. NUM(J,I)=IPT1.NUM(J,IB)
  268. ENDDO
  269. ICOLOR(I)=IPT1.ICOLOR(IB)
  270. ENDDO
  271. ENDIF
  272. IPMAIL=MELEME
  273. C
  274. C ON RECUPERE LES MELVAL ET LES MELEME
  275. C
  276. MELEME=IPMAIL
  277. SEGACT MELEME
  278. *
  279. * modification du meleme pour le remplissage du segment descripteur
  280. * en deformations planes generalisees
  281. *
  282. IF (BDPGE) THEN
  283. IPT2=IPMAIL
  284. C* SEGACT IPT2
  285. NBELEM=IPT2.NUM(/2)
  286. NBNN=IPT2.NUM(/1)+1
  287. NBREF=0
  288. NBSOUS=0
  289. SEGINI MELEME
  290. DO 1007 I=1,NBELEM
  291. DO 1008 J=1,NBNN-1
  292. NUM(J,I)=IPT2.NUM(J,I)
  293. 1008 CONTINUE
  294. NUM(NBNN,I)=IIPDPG
  295. ICOLOR(I)=IPT2.ICOLOR(I)
  296. 1007 CONTINUE
  297. ITYPEL=28
  298. IPMADG=MELEME
  299. SEGDES IPT2
  300. ELSE
  301. NBNN =NUM(/1)
  302. NBELEM=NUM(/2)
  303. ENDIF
  304. IPPORE=0
  305. IF(MFR.EQ.33) IPPORE=NBNN
  306. C
  307. c cas Xfem: DESCR et IMATRI créé par massxr.eso
  308. C* Cas particulier des elements XFEM en cas de partition :
  309. C* Il faut aussi partitionner le modele (nomme imoxfem)
  310. IF (MFR.EQ.63) THEN
  311. IF (nblprt.GT.1) THEN
  312. imoxfem = 0
  313. CALL PARTXR(IMODEL,ipmail,imoxfem)
  314. IF (IERR.NE.0) RETURN
  315. ELSE
  316. imoxfem = IMODEL
  317. ENDIF
  318. GOTO 1999
  319. ENDIF
  320. c
  321. C ---------------------------------------------------------*
  322. C INITIALISATION DU SEGMENT DESCR, SEGMENT DESCRIPTEUR DES *
  323. C DES INCONNUES RELATIVES A LA MATRICE DE RIGIDITE *
  324. C ---------------------------------------------------------*
  325.  
  326. SEGINI DESCR
  327. IPDSCR=DESCR
  328. if(lnomid(1).ne.0) then
  329. nomid=lnomid(1)
  330. segact nomid
  331. modepl=nomid
  332. ndepl=lesobl(/2)
  333. ndum=lesfac(/2)
  334. lsupdp=.false.
  335. else
  336. lsupdp=.true.
  337. CALL IDPRIM(IMODEL,MFR,MODEPL,NDEPL,NDUM)
  338. endif
  339. if(lnomid(2).ne.0) then
  340. nomid=lnomid(2)
  341. segact nomid
  342. moforc=nomid
  343. nforc=lesobl(/2)
  344. lsupfo=.false.
  345. else
  346. lsupfo=.true.
  347. CALL IDDUAL(IMODEL,MFR,MOFORC,NFORC,NDUM)
  348. endif
  349. C
  350. IF (NDEPL.EQ.0.OR.NFORC.EQ.0.OR.NDEPL.NE.NFORC) THEN
  351. CALL ERREUR(5)
  352. SEGSUP DESCR,MRIGID
  353. SEGDES MMODEL,MELEME
  354. RETURN
  355. ENDIF
  356. C
  357. C REMPLISSAGE DU SEGMENT DESCRIPTEUR
  358. C
  359. IDDL=1
  360. NCOMP=NDEPL
  361. NBNNS=NBNN
  362. IF (MFR.EQ.33) NCOMP=NDEPL-1
  363. IF (BDPGE) THEN
  364. NCOMP=NDEPL-NDPGE
  365. NBNNS=NBNN-1
  366. ENDIF
  367. IF (MFR.EQ.19.OR.MFR.EQ.21) NBNNS=NBNN/2
  368. NOMID=MODEPL
  369. SEGACT NOMID
  370. NOMID=MOFORC
  371. SEGACT NOMID
  372. DO 1004 INOEUD=1,NBNNS
  373. DO 1005 ICOMP=1,NCOMP
  374. NOMID=MODEPL
  375. LISINC(IDDL)=LESOBL(ICOMP)
  376. if (dcmat2) then
  377. if (inoeud.eq.2) then
  378. LISINC(IDDL)=LESFAC(ICOMP)
  379. endif
  380. endif
  381. NOMID=MOFORC
  382. LISDUA(IDDL)=LESOBL(ICOMP)
  383. if (dcmat2) then
  384. if (inoeud.eq.2) then
  385. LISDUA(IDDL)=LESFAC(ICOMP)
  386. endif
  387. endif
  388. NOELEP(IDDL)=INOEUD
  389. NOELED(IDDL)=INOEUD
  390. IDDL=IDDL+1
  391. 1005 CONTINUE
  392. 1004 CONTINUE
  393. *
  394. * cas de la deformation plane generalisee
  395. *
  396. IF (BDPGE) THEN
  397. DO 1006 ICOMP=(NDPGE-1),0,-1
  398. NOMID=MODEPL
  399. LISINC(IDDL)=LESOBL(NDEPL-ICOMP)
  400. NOMID=MOFORC
  401. LISDUA(IDDL)=LESOBL(NFORC-ICOMP)
  402. NOELEP(IDDL)=NBNN
  403. NOELED(IDDL)=NBNN
  404. IDDL=IDDL+1
  405. 1006 CONTINUE
  406. ENDIF
  407. C
  408. C CAS DES MILIEUX POREUX
  409. C
  410. IF (MFR.EQ.33) THEN
  411. DO 1104 INOEUD=1,NBSOM(IELE)
  412. NOMID=MODEPL
  413. LISINC(IDDL)=LESOBL(NDEPL)
  414. NOMID=MOFORC
  415. LISDUA(IDDL)=LESOBL(NDEPL)
  416. NOELEP(IDDL)=IBSOM(NSPOS(IELE)+INOEUD-1)
  417. NOELED(IDDL)=IBSOM(NSPOS(IELE)+INOEUD-1)
  418. IDDL=IDDL+1
  419. 1104 CONTINUE
  420. ENDIF
  421. *
  422. * cas des element raccord
  423. *
  424. IF (MFR.EQ.19.OR.MFR.EQ.21) THEN
  425. CALL IDPRIM(IMODEL,MFR+1000,MODPL,NDEPL,NDUM)
  426. CALL IDDUAL(IMODEL,MFR+1000,MOFRC,NFORC,NDUM)
  427. NOMID=MODPL
  428. SEGACT NOMID
  429. NOMID=MOFRC
  430. SEGACT NOMID
  431. DO 1106 INOEUD=NBNNS+1,NBNN
  432. DO 1107 ICOMP=1,NDEPL
  433. NOMID=MODPL
  434. LISINC(IDDL)=LESOBL(ICOMP)
  435. NOMID=MOFRC
  436. LISDUA(IDDL)=LESOBL(ICOMP)
  437. NOELEP(IDDL)=INOEUD
  438. NOELED(IDDL)=INOEUD
  439. IDDL=IDDL+1
  440. 1107 CONTINUE
  441. 1106 CONTINUE
  442. NOMID=MODPL
  443. SEGsup NOMID
  444. NOMID=MOFRC
  445. SEGsup NOMID
  446. ENDIF
  447. NOMID=MODEPL
  448. SEGDES NOMID
  449. NOMID=MOFORC
  450. SEGDES NOMID
  451. SEGDES DESCR
  452. C
  453. C ------------------------------------------------------------*
  454. C INITIALISATION DU SEGMENT IMATRI, CHAPEAU SUR LES SEGMENTS *
  455. C CONTENANT LES MATRICES DE RIGIDITE ELEMENTAIRES *
  456. C ------------------------------------------------------------*
  457. C NBELEM: NB D'ELEMENTS DANS LA SOUS ZONE
  458. NLIGRP=LRE
  459. NLIGRD=LRE
  460. C
  461. NELRIG=NBELEM
  462. SEGINI xMATRI
  463. IPMATR=xMATRI
  464. C
  465. C------------------------------------------------------*
  466. C
  467. C TRAITEMENT DU CHAPEAU DES RIGIDITES, SEGMENT MRIGID *
  468. C------------------------------------------------------*
  469. C
  470. COERIG(isouss)=1.D0
  471. IF (BDPGE) THEN
  472. IRIGEL(1,isouss)=IPMADG
  473. ELSE
  474. IRIGEL(1,isouss)=IPMAIL
  475. ENDIF
  476. IRIGEL(2,isouss)=0
  477. IRIGEL(3,isouss)=IPDSCR
  478. IRIGEL(4,isouss)=xMATRI
  479. IRIGEL(5,isouss)=NHRM
  480. IRIGEL(6,isouss)=0
  481. IRIGEL(7,isouss)=0
  482. IRIGEL(8,isouss)=0
  483. IF (BDPGE) THEN
  484. SEGDES MELEME
  485. MELEME=IPMAIL
  486. SEGACT MELEME
  487. NBNN=NUM(/1)
  488. ENDIF
  489. C
  490. C CAS DE L'OPERATEUR LUMP ON INDIQUE QUE LA MATRICE MASSE GENEREE EST DIAGONALE
  491. C
  492. * IF (ILUMP .EQ. 1) THEN
  493. * IRIGEL(7,isouss) = 3
  494. * ENDIF
  495. c
  496. 1999 continue
  497. C_______________________________________________________________________
  498. C
  499. C TRAITEMENT DES CHAMP MATERIAUX
  500. C_______________________________________________________________________
  501. C
  502. NBROBL=0
  503. NBRFAC=0
  504. MOMATR=0
  505. IVAMAT=0
  506. IVACAR=0
  507. LHOTRA=0
  508. *
  509. * JOINT UNIDIMENSIONNEL JOI1
  510. *
  511. IF (MFR.EQ.75) THEN
  512. IF (IDIM.EQ.3) THEN
  513. NBROBL=10
  514. SEGINI NOMID
  515. LESOBL(1)='V1X'
  516. LESOBL(2)='V1Y'
  517. LESOBL(3)='V1Z'
  518. LESOBL(4)='V2X'
  519. LESOBL(5)='V2Y'
  520. LESOBL(6)='V2Z'
  521. LESOBL(7)='MASS'
  522. LESOBL(8)='JX'
  523. LESOBL(9)='JY'
  524. LESOBL(10)='JZ'
  525. ELSE IF (IDIM.EQ.2) THEN
  526. NBROBL=4
  527. SEGINI NOMID
  528. LESOBL(1)='V1X'
  529. LESOBL(2)='V1Y'
  530. LESOBL(3)='MASS'
  531. LESOBL(4)='JZ'
  532. ENDIF
  533. *
  534. NBTYPE=1
  535. SEGINI NOTYPE
  536. TYPE(1)='REAL*8'
  537. MOMATR=NOMID
  538. MOTYPE=NOTYPE
  539. *
  540. * rho dans les cas,massif,coq3,poutre,tuyau,coq8,coq2,barre,jot3,joi4,joi2,xfem
  541. *
  542. ELSE IF (MFR.EQ.1.OR.MFR.EQ.7.OR.MFR.EQ.13.OR.MFR.EQ.3.
  543. 1 OR.MFR.EQ.27.OR.MFR.EQ.9.OR.MFR.EQ.35.OR.MFR.EQ.31.
  544. 2 OR.MFR.EQ.49.OR.MFR.EQ.53.OR.MFR.EQ.63.OR.MFR.EQ.5) THEN
  545. *
  546. IF(CMATE.NE.'SECTION') THEN
  547. NBROBL=1
  548. SEGINI NOMID
  549. LESOBL(1)='RHO '
  550. NBTYPE=1
  551. SEGINI NOTYPE
  552. TYPE(1)='REAL*8'
  553. ELSE
  554. LHOTRA=LHOOK
  555. NBROBL=2
  556. SEGINI NOMID
  557. MOMATR=NOMID
  558. LESOBL(1)='MODS'
  559. LESOBL(2)='MATS'
  560. NBTYPE=2
  561. SEGINI NOTYPE
  562. TYPE(1)='POINTEURMMODEL'
  563. TYPE(2)='POINTEURMCHAML'
  564. ENDIF
  565. MOMATR=NOMID
  566. MOTYPE=NOTYPE
  567. *
  568. * rhoref rlcar dans le cas des elements de raccord et surface libre
  569. *
  570. ELSE IF (MFR.EQ.19.OR.MFR.EQ.21.OR.MFR.EQ.23) THEN
  571. NBROBL=2
  572. NBRFAC=0
  573. SEGINI NOMID
  574. MOMATR=NOMID
  575. LESOBL(1)='RORF'
  576. LESOBL(2)='LCAR'
  577. *
  578. NBTYPE=1
  579. SEGINI NOTYPE
  580. MOTYPE=NOTYPE
  581. TYPE(1)='REAL*8'
  582. *
  583. * caracteristiques pour les elements liquides
  584. *
  585. ELSE IF (MFR.EQ.11) THEN
  586. NBROBL=5
  587. NBRFAC=0
  588. SEGINI NOMID
  589. MOMATR=NOMID
  590. LESOBL(1)='RHO '
  591. LESOBL(2)='CSON'
  592. LESOBL(3)='RORF'
  593. LESOBL(4)='CREF'
  594. LESOBL(5)='LCAR'
  595. *
  596. NBTYPE=1
  597. SEGINI NOTYPE
  598. MOTYPE=NOTYPE
  599. TYPE(1)='REAL*8'
  600. *
  601. * caracteristiques pour les elements homogeneises
  602. *
  603. ELSE IF (MFR.EQ.37) THEN
  604. IF (MELE.EQ.157) THEN
  605. NBROBL=15
  606. NBRFAC=0
  607. SEGINI NOMID
  608. MOMATR=NOMID
  609. LESOBL(1)='B11 '
  610. LESOBL(2)='B22 '
  611. LESOBL(3)='B12 '
  612. LESOBL(4)='ROF '
  613. LESOBL(5)='ROS '
  614. LESOBL(6)='CSON'
  615. LESOBL(7)='RORF'
  616. LESOBL(8)='CREF'
  617. LESOBL(9)='LCAR'
  618. LESOBL(10)='E111'
  619. LESOBL(11)='E112'
  620. LESOBL(12)='E121'
  621. LESOBL(13)='E122'
  622. LESOBL(14)='E221'
  623. LESOBL(15)='E222'
  624. ELSE
  625. NBROBL=9
  626. NBRFAC=0
  627. SEGINI NOMID
  628. MOMATR=NOMID
  629. LESOBL(1)='B11 '
  630. LESOBL(2)='B22 '
  631. LESOBL(3)='B12 '
  632. LESOBL(4)='ROF '
  633. LESOBL(5)='ROS '
  634. LESOBL(6)='CSON'
  635. LESOBL(7)='RORF'
  636. LESOBL(8)='CREF'
  637. LESOBL(9)='LCAR'
  638. ENDIF
  639. *
  640. NBTYPE=1
  641. SEGINI NOTYPE
  642. MOTYPE=NOTYPE
  643. TYPE(1)='REAL*8'
  644. *
  645. * caracteristiques pour l'element acoustique pure
  646. *
  647. ELSE IF (MFR.EQ.41) THEN
  648. NBROBL=5
  649. NBRFAC=0
  650. SEGINI NOMID
  651. MOMATR=NOMID
  652. LESOBL(1)='RHO '
  653. LESOBL(2)='CSON'
  654. LESOBL(3)='RORF'
  655. LESOBL(4)='CREF'
  656. LESOBL(5)='LCAR'
  657. *
  658. NBTYPE=1
  659. SEGINI NOTYPE
  660. MOTYPE=NOTYPE
  661. TYPE(1)='REAL*8'
  662. *
  663. * caracteristiques pour l'element raccord liquide tuyau
  664. *
  665. ELSE IF (MFR.EQ.43) THEN
  666. NBROBL=3
  667. NBRFAC=0
  668. SEGINI NOMID
  669. MOMATR=NOMID
  670. LESOBL(1)='RHO '
  671. LESOBL(3)='RORF'
  672. LESOBL(2)='LCAR'
  673. *
  674. NBTYPE=1
  675. SEGINI NOTYPE
  676. MOTYPE=NOTYPE
  677. TYPE(1)='REAL*8'
  678. *
  679. * caracteristiques pour les joints generalises
  680. *
  681. ELSE IF (MFR.EQ.55) THEN
  682. CcPPj NBROBL=2
  683. CcPPj NBRFAC=0
  684. CcPPj SEGINI NOMID
  685. CcPPj MOMATR=NOMID
  686. CcPPj LESOBL(1)='RHO '
  687. CcPPj LESOBL(2)='EPAI'
  688. NBROBL=1
  689. NBRFAC=1
  690. SEGINI NOMID
  691. MOMATR=NOMID
  692. LESOBL(1)='RHO '
  693. LESFAC(1)='EPAI'
  694. *
  695. NBTYPE=1
  696. SEGINI NOTYPE
  697. MOTYPE=NOTYPE
  698. TYPE(1)='REAL*8'
  699. *
  700. * poi1 -- MODAL
  701. *
  702. ELSE IF (CMATE.EQ.'MODAL') THEN
  703. NBROBL=3
  704. NBRFAC=0
  705. SEGINI NOMID
  706. MOMATR=NOMID
  707. LESOBL(1)='FREQ'
  708. LESOBL(2)='MASS'
  709. LESOBL(3)='DEFO'
  710. *
  711. NBTYPE=3
  712. SEGINI NOTYPE
  713. MOTYPE=NOTYPE
  714. TYPE(1)='REAL*8'
  715. TYPE(2)='REAL*8'
  716. TYPE(3)='POINTEURCHPOINT'
  717. *
  718. * poi1 -- STATIQUE
  719. *
  720. ELSE IF (CMATE.EQ.'STATIQUE') THEN
  721. NBROBL=3
  722. NBRFAC=0
  723. SEGINI NOMID
  724. MOMATR=NOMID
  725. LESOBL(1)='DEFO'
  726. LESOBL(2)='RIDE'
  727. LESOBL(3)='MADE'
  728. *
  729. NBTYPE=1
  730. SEGINI NOTYPE
  731. MOTYPE=NOTYPE
  732. TYPE(1)='POINTEURCHPOINT'
  733. *
  734. ENDIF
  735.  
  736. DO imat = 1 , matmod(/2)
  737. IF (matmod(imat).eq.'IMPEDANCE') THEN
  738.  
  739. NBROBL=0
  740. NBRFAC=2
  741. SEGINI NOMID
  742. MOMATR=NOMID
  743. LESFAC(1)='MASS'
  744. LESFAC(2)='INER'
  745. *
  746. NBTYPE=1
  747. SEGINI NOTYPE
  748. MOTYPE=NOTYPE
  749. TYPE(1)='REAL*8'
  750.  
  751. ENDIF
  752. ENDDO
  753. C
  754. NMATR=NBROBL
  755. NMATF=NBRFAC
  756. NMATT=NMATR+NMATF
  757.  
  758. IF (MOMATR.NE.0) THEN
  759. *
  760. * verification du support des composantes recherchees
  761. *
  762. CALL QUESUQ(IMODEL,IPCHE1,4,0,MOMATR,isupo,ISUP,IRET1)
  763. IF(ISUP.GT.1)THEN
  764. SEGSUP NOTYPE
  765. GO TO 9990
  766. ENDIF
  767. *
  768. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  769. SEGSUP NOTYPE
  770. IF (IERR.NE.0) THEN
  771. GOTO 9990
  772. ENDIF
  773. IF(ISUP.EQ.1)THEN
  774. CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  775. IF(IERR.NE.0)THEN
  776. ISUP=0
  777. GOTO 9990
  778. ENDIF
  779. ENDIF
  780. if (cmate.eq.'STATIQUE'.or.cmate.eq.'MODAL') then
  781. mptval = ivamat
  782. segact mptval
  783. if (ival(/1).lt.3) call erreur(5)
  784. endif
  785. if (cmate.eq.'STATIQUE') then
  786. kstat = kstat + 1
  787. ivstat(kstat) = ivamat
  788. pistat(kstat) = imodel
  789. if (kstat.eq.nstat) then
  790. nstat = nstat + 100
  791. segadj modsta
  792. endif
  793. endif
  794. if (cmate.eq.'MODAL') then
  795. kmoda = kmoda + 1
  796. ivmoda(kmoda) = ivamat
  797. pimoda(kmoda) = imodel
  798. if (kmoda.eq.nmoda) then
  799. nmoda = nmoda + 100
  800. segadj modsta
  801. endif
  802. endif
  803. ENDIF
  804. C
  805. C____________________________________________________________________
  806. C
  807. C TRAITEMENT DES CHAMPS DE CARACTERISTIQUES
  808. C____________________________________________________________________
  809. C
  810. NBROBL=0
  811. NBRFAC=0
  812. MOCARA=0
  813. NCARA=0
  814. NCARF=0
  815. NCARR=0
  816. IVECT=0
  817. *
  818. * epaisseur dans le cas massif en contraintes planes
  819. *
  820. IF((MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.63.OR.MELE.EQ.35.OR.
  821. +MELE.EQ.36.OR.MELE.EQ.63).AND.IFOUR.EQ.-2)THEN
  822. NBROBL=0
  823. NBRFAC=1
  824. SEGINI NOMID
  825. MOCARA=NOMID
  826. LESFAC(1)='DIM3'
  827. *
  828. NBTYPE=1
  829. SEGINI NOTYPE
  830. MOTYPE=NOTYPE
  831. TYPE(1)='REAL*8'
  832. *
  833. * epaisseur et excentrement dans le cas des coques
  834. *
  835. ELSEIF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  836. NBROBL=1
  837. IF(MFR.EQ.3.AND.IFOUR.EQ.-2) THEN
  838. NBRFAC=2
  839. ELSE
  840. NBRFAC=1
  841. ENDIF
  842. SEGINI NOMID
  843. MOCARA=NOMID
  844. LESOBL(1)='EPAI'
  845. LESFAC(1)='EXCE'
  846. IF(MFR.EQ.3.AND.IFOUR.EQ.-2) LESFAC(2)='DIM3'
  847. *
  848. NBTYPE=1
  849. SEGINI NOTYPE
  850. MOTYPE=NOTYPE
  851. TYPE(1)='REAL*8'
  852. *
  853. * section pour les barres et les cerces
  854. *
  855. ELSE IF (MFR.EQ.27) THEN
  856. IF(.NOT.dcmate) THEN
  857. NBROBL=1
  858. SEGINI NOMID
  859. MOCARA=NOMID
  860. LESOBL(1)='SECT'
  861. *
  862. NBTYPE=1
  863. SEGINI NOTYPE
  864. MOTYPE=NOTYPE
  865. TYPE(1)='REAL*8'
  866. ENDIF
  867. *
  868. * section, excentrements et orientation pour les barres excentrees
  869. *
  870. ELSE IF (MFR.EQ.49) THEN
  871. NBROBL=6
  872. SEGINI NOMID
  873. MOCARA=NOMID
  874. LESOBL(1)='SECT'
  875. LESOBL(2)='EXCZ'
  876. LESOBL(3)='EXCY'
  877. LESOBL(4)='VX '
  878. LESOBL(5)='VY '
  879. LESOBL(6)='VZ '
  880. *
  881. NBTYPE=1
  882. SEGINI NOTYPE
  883. MOTYPE=NOTYPE
  884. TYPE(1)='REAL*8'
  885. *
  886. * caracteristiques pour les poutres
  887. *
  888. ELSE IF (MFR.EQ.7 ) THEN
  889. if (dcmate) then
  890. NBROBL=0
  891. NBRFAC=1
  892. SEGINI NOMID
  893. MOCARA=NOMID
  894. LESFAC(1)='VECT'
  895. IVECT=1
  896. *
  897. NBTYPE=1
  898. SEGINI NOTYPE
  899. MOTYPE=NOTYPE
  900. TYPE(1)='POINTEURPOINT '
  901. else
  902. IF (CMATE.EQ.'SECTION') THEN
  903. NBROBL=0
  904. NBRFAC=1
  905. SEGINI NOMID
  906. MOCARA=NOMID
  907. LESFAC='VECT'
  908. IVECT=1
  909. *
  910. NBTYPE=1
  911. SEGINI NOTYPE
  912. MOTYPE=NOTYPE
  913. TYPE(1)='POINTEURPOINT '
  914. *
  915. * CAS 2D
  916. ELSE IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  917. NBRFAC=1
  918. NBROBL=2
  919. SEGINI NOMID
  920. MOCARA=NOMID
  921. LESOBL(1)= 'SECT'
  922. LESOBL(2)= 'INRZ'
  923. LESFAC(1)= 'SECY'
  924. *
  925. NBTYPE=1
  926. SEGINI NOTYPE
  927. MOTYPE=NOTYPE
  928. TYPE(1)='REAL*8'
  929. *
  930. ELSE
  931. NBROBL=4
  932. NBRFAC=3
  933. SEGINI NOMID
  934. MOCARA=NOMID
  935. LESOBL(1)='TORS'
  936. LESOBL(2)='INRY'
  937. LESOBL(3)='INRZ'
  938. LESOBL(4)='SECT'
  939. LESFAC(1)='SECY'
  940. LESFAC(2)='SECZ'
  941. LESFAC(3)='VECT'
  942. IVECT=1
  943. *
  944. NBTYPE=7
  945. SEGINI NOTYPE
  946. MOTYPE=NOTYPE
  947. TYPE(1)='REAL*8'
  948. TYPE(2)='REAL*8'
  949. TYPE(3)='REAL*8'
  950. TYPE(4)='REAL*8'
  951. TYPE(5)='REAL*8'
  952. TYPE(6)='REAL*8'
  953. TYPE(7)='POINTEURPOINT '
  954. ENDIF
  955. endif
  956. *
  957. * caracteristiques pour les tuyaux
  958. *
  959. ELSE IF (MFR.EQ.13) THEN
  960. NBROBL=2
  961. NBRFAC=3
  962. SEGINI NOMID
  963. MOCARA=NOMID
  964. LESOBL(1)='EPAI'
  965. LESOBL(2)='RAYO'
  966. LESFAC(1)='RACO'
  967. LESFAC(2)='CISA'
  968. LESFAC(3)='VECT'
  969. IVECT=1
  970. *
  971. NBTYPE=5
  972. SEGINI NOTYPE
  973. MOTYPE=NOTYPE
  974. TYPE(1)='REAL*8'
  975. TYPE(2)='REAL*8'
  976. TYPE(3)='REAL*8'
  977. TYPE(4)='REAL*8'
  978. TYPE(5)='POINTEURPOINT '
  979. *
  980. * caracteristique pour les elements de raccord
  981. *
  982. ELSE IF (MFR.EQ.19.OR.MFR.EQ.21) THEN
  983. IF(IDIM.EQ.2)THEN
  984. NBROBL=2
  985. SEGINI NOMID
  986. MOCARA=NOMID
  987. LESOBL(1)='VX '
  988. LESOBL(2)='VY '
  989. ELSEIF(IDIM.EQ.3)THEN
  990. NBROBL=3
  991. SEGINI NOMID
  992. MOCARA=NOMID
  993. LESOBL(1)='VX '
  994. LESOBL(2)='VY '
  995. LESOBL(3)='VZ '
  996. ENDIF
  997. *
  998. NBTYPE=1
  999. SEGINI NOTYPE
  1000. MOTYPE=NOTYPE
  1001. TYPE(1)='REAL*8'
  1002. *
  1003. * caracteristiques des elements homogeneises
  1004. *
  1005. ELSE IF (MFR.EQ.37) THEN
  1006. IF(IFOUR.EQ.1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.2) THEN
  1007. NBROBL=5
  1008. SEGINI NOMID
  1009. MOCARA=NOMID
  1010. LESOBL(1)='SCEL'
  1011. LESOBL(2)='SFLU'
  1012. LESOBL(3)='EPS '
  1013. LESOBL(4)='SECT'
  1014. LESOBL(5)='INRZ '
  1015. ELSE
  1016. NBROBL=5
  1017. SEGINI NOMID
  1018. MOCARA=NOMID
  1019. LESOBL(1)='SCEL'
  1020. LESOBL(2)='SFLU'
  1021. LESOBL(3)='EPS '
  1022. LESOBL(4)='NOF1'
  1023. LESOBL(5)='NOF2'
  1024. ENDIF
  1025. *
  1026. NBTYPE=1
  1027. SEGINI NOTYPE
  1028. MOTYPE=NOTYPE
  1029. TYPE(1)='REAL*8'
  1030. *
  1031. * caracteristiques de l'element tuyau acoustique
  1032. *
  1033. ELSE IF (MFR.EQ.41) THEN
  1034. NBROBL=1
  1035. NBRFAC=1
  1036. SEGINI NOMID
  1037. MOCARA=NOMID
  1038. LESOBL(1)='RAYO'
  1039. LESFAC(1)='RACO'
  1040. *
  1041. NBTYPE=2
  1042. SEGINI NOTYPE
  1043. MOTYPE=NOTYPE
  1044. TYPE(1)='REAL*8'
  1045. TYPE(2)='REAL*8'
  1046. *
  1047. * caracteristiques de l'element de raccord liquide tuyau
  1048. *
  1049. ELSE IF (MFR.EQ.43) THEN
  1050. NBROBL=1
  1051. NBRFAC=2
  1052. SEGINI NOMID
  1053. MOCARA=NOMID
  1054. LESOBL(1)='RAYO'
  1055. LESFAC(1)='RACO'
  1056. LESFAC(2)='VECT'
  1057. *
  1058. NBTYPE=3
  1059. SEGINI NOTYPE
  1060. MOTYPE=NOTYPE
  1061. TYPE(1)='REAL*8'
  1062. TYPE(2)='REAL*8'
  1063. TYPE(3)='POINTEURPOINT '
  1064. IVECT=1
  1065. ENDIF
  1066.  
  1067. NCARA=NBROBL
  1068. NCARF=NBRFAC
  1069. NCARR=NCARA+NCARF
  1070. *
  1071. IF (MOCARA.NE.0) THEN
  1072. *
  1073. * verification du support des composantes recherchees
  1074. *
  1075. CALL QUESUQ(IMODEL,IPCHE1,4,0,MOCARA,isupo,ISUP,IRET2)
  1076. IF(ISUP.GT.1)THEN
  1077. SEGSUP NOTYPE
  1078. GO TO 9990
  1079. ENDIF
  1080. *
  1081. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,IVACAR)
  1082. SEGSUP NOTYPE
  1083. IF (IERR.NE.0) GOTO 9990
  1084. MPTVAL=IVACAR
  1085. IF(ISUP.EQ.1)THEN
  1086. CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  1087. IF(IERR.NE.0)THEN
  1088. ISUP=0
  1089. GOTO 9990
  1090. ENDIF
  1091. ENDIF
  1092. ENDIF
  1093. C
  1094. imod = imodel
  1095. C_______________________________________________________________________
  1096. C
  1097. C NUMERO DES ETIQUETTES :
  1098. C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  1099. C LES ELEMENTS SONT GROUPES COMME SUIT :
  1100. C - MASSIF,LIQUIDE 'SURFACE LIBRE' ----------------------> MASSE2
  1101. C - COQ3/POUTRE,DKT,COQ4,COQ8,COQ2,DST ------------------> MASSE3
  1102. C ET POUTRE DE TIMOSCHENKO
  1103. C - RACCORDS LIQUIDE/MASSIFS,RACCORDS LIQUIDE/COQUES,
  1104. C BARRE,HOMOGENEISE,JOINTS --------------------------> MASSE4
  1105. C_______________________________________________________________________
  1106. IF (MELE.LE.100)
  1107. * CABL SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5 QUA8 QUA9
  1108. & GOTO ( 99, 27, 99, 4, 99, 4, 99, 4, 99, 4, 99
  1109. * RAC2 RAC3 CUB8 CU20 PRI6 PR15 LIA3 LIA4 LIA6 LIA8 MULT
  1110. & , 12, 99, 4, 4, 4, 4, 12, 12, 99, 99, 99
  1111. * TET4 TE10 PYR5 PY13 COQ3 DKT POUT LISP FAC3 FAC4 FAC6
  1112. & , 4, 4, 4, 4, 27, 27, 27, 30, 99, 99, 99
  1113. * FAC8 LTR3 LQU4 LCU8 LPR6 LTE4 LPY5 COQ8 TUYA TUFI COQ2
  1114. & , 99, 4, 4, 4, 4, 4, 4, 27, 27, 43, 27
  1115. * POI1 BARR RACO LSU2 COQ4 LISM COF3 RES2 LSU3 LSU4 LICO
  1116. & , 12, 12, 12, 4, 27, 99, 99, 99, 4, 4, 12
  1117. * COQ6 CVS2 CVS3 CVT3 CVT6 CVQ4 CVQ8 THP5 TH13 THP6 TH15
  1118. & , 27, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  1119. * THC8 TH20 ICT3 ICQ4 ICT6 ICQ8 ICC8 ICT4 ICP6 IC20 IC10
  1120. & , 99, 99, 4, 4, 4, 4, 99, 99, 99, 99, 99
  1121. * IC15 TRIP QUAP CUBP TETP PRIP TIMO JOI2 JOI3 JOT3 JOI4
  1122. & , 99, 99, 99, 99, 99, 99, 27, 12, 99, 12, 12
  1123. * JOI6 JOI8 LISC TRIH DST LIC4 CERC TUYO LSE2 LITU HYT3
  1124. & , 99, 99, 99, 12, 27, 12, 12, 27, 27, 12, 99
  1125. * HYQ4
  1126. & , 99),MELE
  1127. IF (MELE.LE.200)
  1128. * HYT4 HYP6 HYC8 TRIS QUAS POIS FOR3 JOP3 JOP6 JOP8
  1129. & GOTO ( 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  1130. * POL3 POL4 POL5 POL6 POL7 POL8 POL9 PO10 PO11 PO12 PO13
  1131. & , 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4
  1132. * PO14 BAR3 BAEX LIA2 QUAH CUBH ROT3 SEF2 TRF3 QUF4 CUF8
  1133. & , 4, 12, 12, 50, 12, 12, 99, 99, 99, 99, 99
  1134. * PRF6 TEF4 PYF5 MSE3 MTR6 MQU9 MC27 MP18 MT10 MP14 SEF3
  1135. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  1136. * TRF7 QUF9 CF27 PF21 TF15 PF19 SEG6 TR21 QU36 C216 P126
  1137. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  1138. * TE56 PY91 TRH6 ???? ???? ???? ???? ???? ???? ???? ????
  1139. & , 99, 99, 12, 51, 51, 51, 51, 51, 51, 51, 51
  1140. * ???? ???? JCT3 JCI4 JGI2 JGT3 JGI4 ???? ???? ???? ????
  1141. & , 51, 51, 12, 12, 12, 12, 12, 51, 51, 51, 51
  1142. * ???? ???? ???? ???? ???? ???? E183 E184 ???? ???? ????
  1143. & , 51, 51, 51, 51, 51, 51, 4, 4, 51, 51, 51
  1144. * ???? ???? ???? ???? ???? M1D2 M1D3 ???? ???? ???? ????
  1145. & , 51, 51, 51, 51, 51, 4, 4, 51, 51, 51, 51
  1146. * ???? ????
  1147. & , 51, 51),MELE-100
  1148. IF (MELE.LE.300)
  1149. * ???? ???? ???? ???? ???? ???? ???? ???? ????
  1150. & GOTO ( 51, 51, 51, 51, 51, 51, 51, 51, 51
  1151. * ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ????
  1152. & , 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51
  1153. * ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ????
  1154. & , 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51
  1155. * ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ????
  1156. & , 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51
  1157. * ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ????
  1158. & , 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51
  1159. * ???? ???? ???? ???? ???? ???? SHB8 ???? ???? XQ4R XC8R
  1160. & , 51, 51, 51, 51, 51, 51, 4, 51, 51, 63, 63
  1161. * JOI1
  1162. & , 12),MELE-200
  1163. C
  1164. 51 CONTINUE
  1165. 99 CONTINUE
  1166. SEGSUP xMATRI
  1167. IRIGEL(4,isouss)=0
  1168. MOTERR(1:4)=NOMTP(MELE)
  1169. MOTERR(5:12)='MASSE'
  1170. CALL ERREUR(86)
  1171. GOTO 9990
  1172. C_______________________________________________________________________
  1173. C
  1174. C MASSIF, LIQUIDE, 'SURFACE LIBRE'
  1175. C_______________________________________________________________________
  1176. C
  1177. 4 CONTINUE
  1178. IF (BDPGE) NDDL=NDDL+NDDLGE
  1179. CALL MASSE2 (IPMAIL,NDDL,LRE,NBPGAU,IPMINT,MELE,MFR,IVAMAT,
  1180. &IVACAR,NMATT,IPMATR,ILUMP,IIPDPG)
  1181. GOTO 510
  1182. C_______________________________________________________________________
  1183. C
  1184. C RACCORDS LIQUIDE/MASSIF,RACCORD LIQUIDE/COQUE,BARRE,HOMOGENEISE,JOT3
  1185. C JOI4,JOI2,JOI1
  1186. C_______________________________________________________________________
  1187. C
  1188. 12 CONTINUE
  1189. CALL MASSE4(IPMAIL,LW,LRE,IVAMAT,NMATT,IVACAR,NCARR,IVECT,NBPGAU,
  1190. &IPMINT,NDDL,MELE,MFR,IPMATR,ILUMP,isouss,IIPDPG,imod)
  1191. GOTO 510
  1192. C_______________________________________________________________________
  1193. C
  1194. C COQ3/POUTRE,DKT,COQ4,COQ8,COQ2 ,DST, POUTRE DE TIMOSCHENKO
  1195. C_______________________________________________________________________
  1196. C
  1197. 27 CONTINUE
  1198. CALL MASSE3(IPMAIL,LRE,LW,MELE,IVAMAT,NMATT,IVACAR,NCARR,
  1199. &IVECT,isouss,NBPGAU,IPMINT,IPMIN1,NDDL,MATE,
  1200. &CMATE,LHOTRA,IPMATR,ILUMP,IIPDPG,imod)
  1201. GOTO 510
  1202. C_______________________________________________________________________
  1203. C
  1204. C ELEMENT LINESPRING CA NE PESE RIEN
  1205. C_______________________________________________________________________
  1206. C
  1207. 30 CONTINUE
  1208. * DO 3030 IB=1,NBELEM
  1209. * SEGINI XMATRI
  1210. * IMATTT(IB)=XMATRI
  1211. * SEGDES XMATRI
  1212. * 3030 CONTINUE
  1213. GOTO 510
  1214. CC______________________________________________________________________
  1215. C
  1216. C ELEMENT TUYAU FISSURE CA NE PESE RIEN
  1217. C_______________________________________________________________________
  1218. C
  1219. 43 CONTINUE
  1220. * DO 3043 IB=1,NBELEM
  1221. * SEGINI XMATRI
  1222. * IMATTT(IB)=XMATRI
  1223. * SEGDES XMATRI
  1224. * 3043 CONTINUE
  1225. GOTO 510
  1226. C_______________________________________________________________________
  1227. C
  1228. C ELEMENT LIA2 (LIAISON A 2 NOEUDS) CA NE PESE RIEN
  1229. C_______________________________________________________________________
  1230. C
  1231. 50 CONTINUE
  1232. * DO 3050 IB=1,NBELEM
  1233. * SEGINI XMATRI
  1234. * IMATTT(IB)=XMATRI
  1235. * SEGDES XMATRI
  1236. * 3050 CONTINUE
  1237. GOTO 510
  1238. C_______________________________________________________________________
  1239. C
  1240. C ELEMENT XFEM (MFR = 63)
  1241. C_______________________________________________________________________
  1242. C Le sous-programme MASSXR gere les appels aux elements de type XFEM
  1243. C (imoxfem est le modele complet ou partitionne si necessaire)
  1244. 63 CONTINUE
  1245. CALL MASSXR (isouss,imoxfem,
  1246. $ IVAMAT,IVACAR,NMATT,CMATE, IIPDPG,IPMASS,IRETER)
  1247. IF (IRETER.NE.0) RETURN
  1248. if (nblprt.GT.1) THEN
  1249. imode1 = imoxfem
  1250. segsup,imode1
  1251. endif
  1252. C il n'y aura plus que les desactivations a faire
  1253. GOTO 510
  1254. C_______________________________________________________________________
  1255. C
  1256. C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE IA
  1257. C_______________________________________________________________________
  1258. C
  1259. 510 CONTINUE
  1260. SEGDES MELEME
  1261. C
  1262. IF (ISUP.EQ.1) THEN
  1263. CALL DTMVAL(IVACAR,3)
  1264. ELSE
  1265. CALL DTMVAL(IVACAR,1)
  1266. ENDIF
  1267.  
  1268. if (cmate.eq.'MODAL'.or.cmate.eq.'STATIQUE') goto 519
  1269. IF (ISUP.EQ.1) THEN
  1270. CALL DTMVAL(IVAMAT,3)
  1271. ELSE
  1272. CALL DTMVAL(IVAMAT,1)
  1273. ENDIF
  1274. 519 continue
  1275. C
  1276. NOMID=MOCARA
  1277. IF (MOCARA.NE.0) SEGSUP NOMID
  1278. NOMID=MOMATR
  1279. SEGSUP NOMID
  1280. if(mfr.ne.63) then
  1281. NOMID=MOFORC
  1282. if(lsupfo)SEGSUP NOMID
  1283. NOMID=MODEPL
  1284. if(lsupdp)SEGSUP NOMID
  1285. endif
  1286. C
  1287. * INFO=IPINF
  1288. * SEGSUP INFO
  1289. C
  1290. C ERREUR DANS LES S-P MASSE2 ,MASSE3 ,MASSE4
  1291. C
  1292. IF (IERR.NE.0) GOTO 888
  1293. *
  1294. * Fin de la boucle (5000) de PARTITIONNEMENT du segment XMATRI
  1295. 5000 CONTINUE
  1296. *
  1297. if(mele.ne.260) SEGDES MINTE
  1298. SEGDES IMODEL
  1299. *
  1300. *-----------------------------------------------------------------------
  1301. * Fin de la boucle sur les sous-zones du modele
  1302. *-----------------------------------------------------------------------
  1303. 500 CONTINUE
  1304.  
  1305. IF (isouss.NE.IRIGEL(/2)) THEN
  1306. NRIGEL = isouss
  1307. SEGADJ,MRIGID
  1308. ENDIF
  1309.  
  1310. *termes croises 'STATIQUE'/'MODAL'
  1311. nstat = kstat
  1312. nmoda = kmoda
  1313. segadj modsta
  1314. ir2 = 0
  1315. if (nstat.ne.0) then
  1316. if (nstat.gt.0) call ricroi(modsta, ir2,1)
  1317. if (nstat.gt.0) then
  1318. do kstat=1,nstat
  1319. mptval = ivstat(kstat)
  1320. segact mptval
  1321. IF (ISUP.EQ.1) THEN
  1322. CALL DTMVAL(mptval,3)
  1323. ELSE
  1324. CALL DTMVAL(mptval,1)
  1325. ENDIF
  1326. enddo
  1327. endif
  1328. if (nmoda.gt.0) then
  1329. do kmoda=1,nmoda
  1330. mptval = ivmoda(kmoda)
  1331. segact mptval
  1332. IF (ISUP.EQ.1) THEN
  1333. CALL DTMVAL(mptval,3)
  1334. ELSE
  1335. CALL DTMVAL(mptval,1)
  1336. ENDIF
  1337. enddo
  1338. endif
  1339. endif
  1340. IRET = 1
  1341.  
  1342. 888 CONTINUE
  1343. if (ierr.eq.0.and.ir2.gt.0) then
  1344. ir1 = mrigid
  1345. call fusrig(ir1,ir2,ir3)
  1346. mrigid = ir3
  1347. ipmass = mrigid
  1348. endif
  1349. segsup modsta
  1350. SEGDES MRIGID
  1351. GOTO 666
  1352. C
  1353. C ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  1354. C
  1355. 9990 CONTINUE
  1356. IRET=0
  1357. C
  1358. IF (ISUP.EQ.1) THEN
  1359. CALL DTMVAL(IVAMAT,3)
  1360. CALL DTMVAL(IVACAR,3)
  1361. ELSE
  1362. CALL DTMVAL(IVAMAT,1)
  1363. CALL DTMVAL(IVACAR,1)
  1364. ENDIF
  1365. C
  1366. NOMID=MOMATR
  1367. IF (MOMATR.NE.0) SEGSUP NOMID
  1368. NOMID=MOCARA
  1369. IF (MOCARA.NE.0) SEGSUP NOMID
  1370. if(mfr.ne.63) then
  1371. NOMID=MOFORC
  1372. if(lsupfo)SEGSUP NOMID
  1373. NOMID=MODEPL
  1374. if(lsupdp)SEGSUP NOMID
  1375. endif
  1376. if(mele.ne.260) SEGDES MINTE
  1377. C
  1378. 9995 CONTINUE
  1379. SEGDES,IPT1
  1380. 9996 CONTINUE
  1381. SEGDES IMODEL
  1382. SEGSUP MRIGID
  1383. C
  1384. 666 CONTINUE
  1385. MMODEL = IPMODL
  1386. * SEGDES MMODEL
  1387. SEGSUP,MMODEL
  1388.  
  1389. RETURN
  1390. END
  1391.  
  1392.  
  1393.  
  1394.  
  1395.  
  1396.  
  1397.  
  1398.  
  1399.  
  1400.  
  1401.  
  1402.  
  1403.  
  1404.  
  1405.  
  1406.  

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