Télécharger masse1.eso

Retour à la liste

Numérotation des lignes :

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

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