Télécharger masse1.eso

Retour à la liste

Numérotation des lignes :

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

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