Télécharger masse1.eso

Retour à la liste

Numérotation des lignes :

  1. C MASSE1 SOURCE BP208322 20/05/27 21:15:04 10617
  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 PPARAM
  29. -INC CCOPTIO
  30. -INC CCHAMP
  31. -INC CCGEOME
  32. -INC CCREEL
  33. -INC SMRIGID
  34. -INC SMCHAML
  35. -INC SMELEME
  36. -INC SMCOORD
  37. -INC SMINTE
  38. -INC SMMODEL
  39. C
  40. SEGMENT INFO
  41. INTEGER INFELL(JG)
  42. ENDSEGMENT
  43. C
  44. SEGMENT NOTYPE
  45. C
  46. CHARACTER*16 TYPE(NBTYPE)
  47. ENDSEGMENT
  48. C
  49. SEGMENT MPTVAL
  50. INTEGER IPOS(NS),NSOF(NS)
  51. INTEGER IVAL(NCOSOU)
  52. CHARACTER*16 TYVAL(NCOSOU)
  53. ENDSEGMENT
  54. C
  55. segment modsta
  56. integer pimoda(nmoda),pistat(nstat)
  57. integer ivmoda(nmoda),ivstat(nstat)
  58. endsegment
  59. C
  60. CHARACTER*8 CMATE
  61. CHARACTER*(NCONCH) CONM
  62. PARAMETER (NINF=3)
  63. INTEGER INFOS(NINF)
  64. LOGICAL BDPGE,lsupfo,lsupdp,dcmate,dcmat2
  65. C
  66. NHRM=NIFOUR
  67.  
  68. IRET = 0
  69. NOMID = 0
  70. mocara = 0
  71. lsupdp=.false.
  72. lsupfo=.false.
  73. *
  74. * verification du lieu support du mchaml de caracteristiques
  75. *
  76. * am 5/1/95 on remplace par un appel a quesup plus
  77. * loin pour ne tester que sur les composantes ad hoc
  78. *
  79. * call quesup(ipmodl,ipche1,4,0,isup)
  80. * if(isup.gt.1) return
  81. C
  82. C ACTIVATION DU MODELE
  83. C
  84. * MODORI = Modele initial complet
  85. * IPMODL = Modele "deroule" (uniquement "MECANIQUE", "LIQUIDE" ou "POREUX")
  86. CALL PIMODL(MODORI,IPMODL)
  87. IF (IPMODL.EQ.0) RETURN
  88. * IPMODL est ACTIF en retour (nouveau pointeur pouvant etre detruit)
  89. MMODEL=IPMODL
  90. NSOUS=KMODEL(/1)
  91. C
  92. C CREATION DE L'OBJET MATRICE DE MASSE
  93. C
  94. NRIGEL=0
  95. SEGINI,MRIGID
  96. IPMASS=MRIGID
  97. MTYMAT='MASSE'
  98. IFORIG=IFOUR
  99. ICHOLE=0
  100. IMGEO1=0
  101. IMGEO2=0
  102. ISUPEQ=0
  103.  
  104. * termes croises STATIQUE et/ou MODAL
  105. nstat = 100
  106. kstat = 0
  107. nmoda = 100
  108. kmoda = 0
  109. segini modsta
  110. C_______________________________________________________________________
  111. C
  112. C DEBUT DE LA BOUCLE SUR LES DIFFERENTES SOUS ZONES
  113. C_______________________________________________________________________
  114. C
  115. isouss=0
  116. DO 500 ISOUS=1,NSOUS
  117. C
  118. C ON RECUPERE LINFORMATION GENERALES
  119. C
  120. IMODEL=KMODEL(ISOUS)
  121. SEGACT IMODEL
  122. *
  123. IIPDPG = imodel.IPDPGE
  124. IIPDPG = IPTPOI(IIPDPG)
  125. IPMAIL = imodel.IMAMOD
  126. CONM = imodel.CONMOD
  127. dcmate = .false.
  128. dcmat2 = .false.
  129. C
  130. C TRAITEMENT DU MODELE
  131. C
  132. MELE=NEFMOD
  133. * Cas particulier des relations de conformites : pas de masse
  134. IF (MELE.EQ.22) GOTO 500
  135. IF (MELE.EQ.259) GOTO 500
  136. *
  137. npint=1
  138. if (infmod(/1).ne.0) npint = infmod(1)
  139. C
  140. C NATURE DU MATERIAU
  141. C
  142. CMATE = CMATEE
  143. MATE = IMATEE
  144. INAT = INATUU
  145.  
  146. do im = 1,matmod(/2)
  147. if (matmod(im).eq.'IMPEDANCE') then
  148. dcmate =.true.
  149. if(tymode(/2).gt.0)then
  150. * detecte impedance seg2 hybride ddl
  151. if(tymode(1).eq.'LISTMOTS') dcmat2 = .true.
  152. endif
  153. endif
  154. enddo
  155. C
  156. C CREATION DU TABLEAU INFOS
  157. C
  158. IRTD=1
  159. CALL IDENT(IPMAIL,CONM,IPCHE1,0,INFOS,IRTD)
  160. IF (IRTD.EQ.0) GOTO 9996
  161.  
  162. C_______________________________________________________________________
  163. C
  164. C INFORMATION SUR L ELEMENT FINI
  165. C_______________________________________________________________________
  166. C
  167. ipt1 = ipmail
  168. segact,ipt1
  169. C mele = nefmod
  170. C Cas particulier : POI1/SEG2 et IMPEDANCE
  171. IF (dcmate) THEN
  172. if (ipt1.itypel.eq.1) mele = 45
  173. if (ipt1.itypel.eq.2) mele = 2
  174. ENDIF
  175. C
  176. isupo=4
  177. if (npint.eq.12345) isupo=1
  178. * integration aux noeuds
  179.  
  180. if(infmod(/1).lt.2+isupo)then
  181. CALL ELQUOI(MELE,0,isupo,IPINF,IMODEL)
  182. INFO=IPINF
  183. MINTE=INFELL(11)
  184. MINTE1=INFELL(12)
  185. MFR =INFELL(13)
  186. LRE =INFELL(9)
  187. LW =INFELL(7)
  188. LHOOK =INFELL(10)
  189. NDDL =INFELL(15)
  190. IELE=INFELL(14)
  191. ICARA=INFELL(5)
  192. NLIGRP = INFELL(9)
  193. NLIGRD = INFELL(9)
  194. segsup info
  195. if(mele.ne.260) segact minte
  196. * write(6,*) ' premier elquoi'
  197. * write(6,*) 'poigau',(poigau(iou),iou=1,poigau(/1))
  198. * write(6,*) ((shptot(ir,it,1),ir=1,shptot(/1)),it=1,shptot(/2))
  199. else
  200. MINTE=INFMOD(2+isupo)
  201. MINTE1=INFMOD(8)
  202. MFR =INFELE(13)
  203. LRE =INFELE(9)
  204. LW =INFELE(7)
  205. LHOOK =INFELE(10)
  206. NDDL =INFELE(15)
  207. IELE=INFELE(14)
  208. ICARA=INFELE(5)
  209. NLIGRP = INFELE(9)
  210. NLIGRD = INFELE(9)
  211. endif
  212. IPMINT=MINTE
  213. IPMIN1=MINTE1
  214. * segact minte
  215. * write(6,*) ' deuxieme elquoi'
  216. * write(6,*) 'poigau',(poigau(iou),iou=1,poigau(/1))
  217. * write(6,*) ((shptot(ir,it,1),ir=1,shptot(/1)),it=1,shptot(/2))
  218. C
  219. C INITIALISATION DE MINTE
  220. C
  221. if(mele.ne.260) then
  222. SEGACT MINTE
  223. NBPGAU=POIGAU(/1)
  224. else
  225. NBPGAU=5
  226. endif
  227. C
  228. C En cas de point support en DEFO PLAN GENE
  229. CALL INFDPG(MFR,IFOUR, BDPGE,NDPGE)
  230. NDDLGE = NDPGE
  231. IF (BDPGE) THEN
  232. IF (IIPDPG.LE.0) THEN
  233. CALL ERREUR(925)
  234. GOTO 9995
  235. ENDIF
  236. C* Cas particulier (pourquoi ?)
  237. IF (IFOUR.EQ.-3) NDDLGE = 1
  238. ENDIF
  239. C
  240. * Preparation du PARTITIONNEMENT du segment XMATRI
  241. LTRK=OOOVAL(1,4)
  242. IF (LTRK.EQ.0) LTRK=OOOVAL(1,1)
  243. IPT1=IPMAIL
  244. SEGACT,IPT1
  245. NBNN1 =IPT1.NUM(/1)
  246. NBELE1=IPT1.NUM(/2)
  247. * Ajout a la taille en mots de la matrice des infos du segment
  248. LSEG=LRE*LRE*NBELE1 + 16
  249. NBLPRT=(LSEG-1)/LTRK+1
  250. NBLMAX=(NBELE1-1)/NBLPRT+1
  251. NBLPRT=(NBELE1-1)/NBLMAX+1
  252. * write (ioimp,*) ' masse1 nblprt nblmax ',NBLPRT,NBLMAX,NBELE1
  253. NRIGEL = IRIGEL(/2) + NBLPRT
  254. SEGADJ,MRIGID
  255. IPMASS=MRIGID
  256. MELEME=IPT1
  257.  
  258. * Boucle (5000) de PARTITIONNEMENT du segment XMATRI
  259. DO 5000 IPRT = 1,NBLPRT
  260. isouss=isouss+1
  261. IF (NBLPRT.GT.1) THEN
  262. JPRT=(IPRT-1)*NBLMAX
  263. SEGACT,IPT1
  264. NBSOUS=0
  265. NBREF=0
  266. NBNN=NBNN1
  267. NBELEM=MIN(NBLMAX,NBELE1-JPRT)
  268. * write (6,*) ' creation segment ',nbnn,nbelem
  269. SEGINI,MELEME
  270. ITYPEL=IPT1.ITYPEL
  271. DO I=1,NBELEM
  272. IB=I+JPRT
  273. DO J=1,NBNN
  274. NUM(J,I)=IPT1.NUM(J,IB)
  275. ENDDO
  276. ICOLOR(I)=IPT1.ICOLOR(IB)
  277. ENDDO
  278. ENDIF
  279. IPMAIL=MELEME
  280. C
  281. C ON RECUPERE LES MELVAL ET LES MELEME
  282. C
  283. MELEME=IPMAIL
  284. SEGACT MELEME
  285. *
  286. * modification du meleme pour le remplissage du segment descripteur
  287. * en deformations planes generalisees
  288. *
  289. IF (BDPGE) THEN
  290. IPT2=IPMAIL
  291. C* SEGACT IPT2
  292. NBELEM=IPT2.NUM(/2)
  293. NBNN=IPT2.NUM(/1)+1
  294. NBREF=0
  295. NBSOUS=0
  296. SEGINI MELEME
  297. DO 1007 I=1,NBELEM
  298. DO 1008 J=1,NBNN-1
  299. NUM(J,I)=IPT2.NUM(J,I)
  300. 1008 CONTINUE
  301. NUM(NBNN,I)=IIPDPG
  302. ICOLOR(I)=IPT2.ICOLOR(I)
  303. 1007 CONTINUE
  304. ITYPEL=28
  305. IPMADG=MELEME
  306. ELSE
  307. NBNN =NUM(/1)
  308. NBELEM=NUM(/2)
  309. ENDIF
  310. IPPORE=0
  311. IF(MFR.EQ.33) IPPORE=NBNN
  312. C
  313. c cas Xfem: DESCR et IMATRI créé par massxr.eso
  314. C* Cas particulier des elements XFEM en cas de partition :
  315. C* Il faut aussi partitionner le modele (nomme imoxfem)
  316. IF (MFR.EQ.63) THEN
  317. IF (nblprt.GT.1) THEN
  318. imoxfem = 0
  319. CALL PARTXR(IMODEL,ipmail,imoxfem)
  320. IF (IERR.NE.0) RETURN
  321. ELSE
  322. imoxfem = IMODEL
  323. ENDIF
  324. GOTO 1999
  325. ENDIF
  326. c
  327. C ---------------------------------------------------------*
  328. C INITIALISATION DU SEGMENT DESCR, SEGMENT DESCRIPTEUR DES *
  329. C DES INCONNUES RELATIVES A LA MATRICE DE RIGIDITE *
  330. C ---------------------------------------------------------*
  331.  
  332. SEGINI DESCR
  333. IPDSCR=DESCR
  334. if(lnomid(1).ne.0) then
  335. nomid=lnomid(1)
  336. segact nomid
  337. modepl=nomid
  338. ndepl=lesobl(/2)
  339. ndum=lesfac(/2)
  340. lsupdp=.false.
  341. else
  342. lsupdp=.true.
  343. CALL IDPRIM(IMODEL,MFR,MODEPL,NDEPL,NDUM)
  344. endif
  345. if(lnomid(2).ne.0) then
  346. nomid=lnomid(2)
  347. segact nomid
  348. moforc=nomid
  349. nforc=lesobl(/2)
  350. lsupfo=.false.
  351. else
  352. lsupfo=.true.
  353. CALL IDDUAL(IMODEL,MFR,MOFORC,NFORC,NDUM)
  354. endif
  355. C
  356. IF (NDEPL.EQ.0.OR.NFORC.EQ.0.OR.NDEPL.NE.NFORC) THEN
  357. CALL ERREUR(5)
  358. SEGSUP DESCR,MRIGID
  359. RETURN
  360. ENDIF
  361. C
  362. C REMPLISSAGE DU SEGMENT DESCRIPTEUR
  363. C
  364. IDDL=1
  365. NCOMP=NDEPL
  366. NBNNS=NBNN
  367. IF (MFR.EQ.33) NCOMP=NDEPL-1
  368. IF (BDPGE) THEN
  369. NCOMP=NDEPL-NDPGE
  370. NBNNS=NBNN-1
  371. ENDIF
  372. IF (MFR.EQ.19.OR.MFR.EQ.21) NBNNS=NBNN/2
  373. NOMID=MODEPL
  374. SEGACT NOMID
  375. NOMID=MOFORC
  376. SEGACT NOMID
  377. DO 1004 INOEUD=1,NBNNS
  378. DO 1005 ICOMP=1,NCOMP
  379. NOMID=MODEPL
  380. LISINC(IDDL)=LESOBL(ICOMP)
  381. if (dcmat2) then
  382. if (inoeud.eq.2) then
  383. LISINC(IDDL)=LESFAC(ICOMP)
  384. endif
  385. endif
  386. NOMID=MOFORC
  387. LISDUA(IDDL)=LESOBL(ICOMP)
  388. if (dcmat2) then
  389. if (inoeud.eq.2) then
  390. LISDUA(IDDL)=LESFAC(ICOMP)
  391. endif
  392. endif
  393. NOELEP(IDDL)=INOEUD
  394. NOELED(IDDL)=INOEUD
  395. IDDL=IDDL+1
  396. 1005 CONTINUE
  397. 1004 CONTINUE
  398. *
  399. * cas de la deformation plane generalisee
  400. *
  401. IF (BDPGE) THEN
  402. DO 1006 ICOMP=(NDPGE-1),0,-1
  403. NOMID=MODEPL
  404. LISINC(IDDL)=LESOBL(NDEPL-ICOMP)
  405. NOMID=MOFORC
  406. LISDUA(IDDL)=LESOBL(NFORC-ICOMP)
  407. NOELEP(IDDL)=NBNN
  408. NOELED(IDDL)=NBNN
  409. IDDL=IDDL+1
  410. 1006 CONTINUE
  411. ENDIF
  412. C
  413. C CAS DES MILIEUX POREUX
  414. C
  415. IF (MFR.EQ.33) THEN
  416. DO 1104 INOEUD=1,NBSOM(IELE)
  417. NOMID=MODEPL
  418. LISINC(IDDL)=LESOBL(NDEPL)
  419. NOMID=MOFORC
  420. LISDUA(IDDL)=LESOBL(NDEPL)
  421. NOELEP(IDDL)=IBSOM(NSPOS(IELE)+INOEUD-1)
  422. NOELED(IDDL)=IBSOM(NSPOS(IELE)+INOEUD-1)
  423. IDDL=IDDL+1
  424. 1104 CONTINUE
  425. ENDIF
  426. *
  427. * cas des element raccord
  428. *
  429. IF (MFR.EQ.19.OR.MFR.EQ.21) THEN
  430. CALL IDPRIM(IMODEL,MFR+1000,MODPL,NDEPL,NDUM)
  431. CALL IDDUAL(IMODEL,MFR+1000,MOFRC,NFORC,NDUM)
  432. NOMID=MODPL
  433. SEGACT NOMID
  434. NOMID=MOFRC
  435. SEGACT NOMID
  436. DO 1106 INOEUD=NBNNS+1,NBNN
  437. DO 1107 ICOMP=1,NDEPL
  438. NOMID=MODPL
  439. LISINC(IDDL)=LESOBL(ICOMP)
  440. NOMID=MOFRC
  441. LISDUA(IDDL)=LESOBL(ICOMP)
  442. NOELEP(IDDL)=INOEUD
  443. NOELED(IDDL)=INOEUD
  444. IDDL=IDDL+1
  445. 1107 CONTINUE
  446. 1106 CONTINUE
  447. NOMID=MODPL
  448. if(nomid.ne.0) SEGsup NOMID
  449. NOMID=MOFRC
  450. if(nomid.ne.0) SEGsup NOMID
  451. ENDIF
  452. NOMID=MODEPL
  453. NOMID=MOFORC
  454. SEGDES DESCR
  455. C
  456. C ------------------------------------------------------------*
  457. C INITIALISATION DU SEGMENT IMATRI, CHAPEAU SUR LES SEGMENTS *
  458. C CONTENANT LES MATRICES DE RIGIDITE ELEMENTAIRES *
  459. C ------------------------------------------------------------*
  460. C NBELEM: NB D'ELEMENTS DANS LA SOUS ZONE
  461. NLIGRP=LRE
  462. NLIGRD=LRE
  463. C
  464. NELRIG=NBELEM
  465. SEGINI xMATRI
  466. IPMATR=xMATRI
  467. C
  468. C------------------------------------------------------*
  469. C
  470. C TRAITEMENT DU CHAPEAU DES RIGIDITES, SEGMENT MRIGID *
  471. C------------------------------------------------------*
  472. C
  473. COERIG(isouss)=1.D0
  474. IF (BDPGE) THEN
  475. IRIGEL(1,isouss)=IPMADG
  476. ELSE
  477. IRIGEL(1,isouss)=IPMAIL
  478. ENDIF
  479. IRIGEL(2,isouss)=0
  480. IRIGEL(3,isouss)=IPDSCR
  481. IRIGEL(4,isouss)=xMATRI
  482. IRIGEL(5,isouss)=NHRM
  483. IRIGEL(6,isouss)=0
  484. IRIGEL(7,isouss)=0
  485. xmatri.symre=0
  486. IRIGEL(8,isouss)=0
  487. IF (BDPGE) THEN
  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. C
  1264. IF (ISUP.EQ.1) THEN
  1265. c CALL DTMVAL(IVACAR,3)
  1266. MPTVAL=IVACAR
  1267. SEGSUP,MPTVAL
  1268. c ELSE
  1269. c CALL DTMVAL(IVACAR,1)
  1270. ENDIF
  1271.  
  1272. if (cmate.eq.'MODAL'.or.cmate.eq.'STATIQUE') goto 519
  1273. IF (ISUP.EQ.1) THEN
  1274. c CALL DTMVAL(IVAMAT,3)
  1275. MPTVAL=IVAMAT
  1276. SEGSUP,MPTVAL
  1277. c ELSE
  1278. c CALL DTMVAL(IVAMAT,1)
  1279. ENDIF
  1280. 519 continue
  1281. C
  1282. NOMID=MOCARA
  1283. IF (MOCARA.NE.0.and.nomid.ne.0) SEGSUP NOMID
  1284. NOMID=MOMATR
  1285. SEGSUP NOMID
  1286. if(mfr.ne.63) then
  1287. NOMID=MOFORC
  1288. if(lsupfo.and.nomid.ne.0) SEGSUP NOMID
  1289. NOMID=MODEPL
  1290. if(lsupdp.and.nomid.ne.0) SEGSUP NOMID
  1291. endif
  1292. C
  1293. * INFO=IPINF
  1294. * SEGSUP INFO
  1295. C
  1296. C ERREUR DANS LES S-P MASSE2 ,MASSE3 ,MASSE4
  1297. C
  1298. IF (IERR.NE.0) GOTO 888
  1299. *
  1300. * Fin de la boucle (5000) de PARTITIONNEMENT du segment XMATRI
  1301. 5000 CONTINUE
  1302. *
  1303. *
  1304. *-----------------------------------------------------------------------
  1305. * Fin de la boucle sur les sous-zones du modele
  1306. *-----------------------------------------------------------------------
  1307. 500 CONTINUE
  1308.  
  1309. IF (isouss.NE.IRIGEL(/2)) THEN
  1310. NRIGEL = isouss
  1311. SEGADJ,MRIGID
  1312. ENDIF
  1313.  
  1314. *termes croises 'STATIQUE'/'MODAL'
  1315. nstat = kstat
  1316. nmoda = kmoda
  1317. segadj modsta
  1318. ir2 = 0
  1319. if (nstat.ne.0) then
  1320. if (nstat.gt.0) call ricroi(modsta, ir2,1)
  1321. if (nstat.gt.0) then
  1322. do kstat=1,nstat
  1323. mptval = ivstat(kstat)
  1324. c segact mptval
  1325. IF (ISUP.EQ.1) THEN
  1326. c CALL DTMVAL(mptval,3)
  1327. SEGSUP,MPTVAL
  1328. c ELSE
  1329. c CALL DTMVAL(mptval,1)
  1330. ENDIF
  1331. enddo
  1332. endif
  1333. if (nmoda.gt.0) then
  1334. do kmoda=1,nmoda
  1335. mptval = ivmoda(kmoda)
  1336. c segact mptval
  1337. IF (ISUP.EQ.1) THEN
  1338. SEGSUP,MPTVAL
  1339. c CALL DTMVAL(mptval,3)
  1340. c ELSE
  1341. c CALL DTMVAL(mptval,1)
  1342. ENDIF
  1343. enddo
  1344. endif
  1345. endif
  1346. IRET = 1
  1347.  
  1348. 888 CONTINUE
  1349. if (ierr.eq.0.and.ir2.gt.0) then
  1350. ir1 = mrigid
  1351. call fusrig(ir1,ir2,ir3)
  1352. mrigid = ir3
  1353. ipmass = mrigid
  1354. endif
  1355. segsup modsta
  1356. SEGDES MRIGID
  1357. GOTO 666
  1358. C
  1359. C ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  1360. C
  1361. 9990 CONTINUE
  1362. IRET=0
  1363. C
  1364. IF (ISUP.EQ.1) THEN
  1365. c CALL DTMVAL(IVAMAT,3)
  1366. c CALL DTMVAL(IVACAR,3)
  1367. MPTVAL=IVAMAT
  1368. SEGSUP,MPTVAL
  1369. MPTVAL=IVACAR
  1370. SEGSUP,MPTVAL
  1371. c ELSE
  1372. c CALL DTMVAL(IVAMAT,1)
  1373. c CALL DTMVAL(IVACAR,1)
  1374. ENDIF
  1375. C
  1376. NOMID=MOMATR
  1377. IF (MOMATR.NE.0.and.nomid.ne.0) SEGSUP NOMID
  1378. NOMID=MOCARA
  1379. IF (MOCARA.NE.0.and.nomid.ne.0) SEGSUP NOMID
  1380. if(mfr.ne.63) then
  1381. NOMID=MOFORC
  1382. if(lsupfo.and.nomid.ne.0) SEGSUP NOMID
  1383. NOMID=MODEPL
  1384. if(lsupdp.and.nomid.ne.0) SEGSUP NOMID
  1385. endif
  1386. C
  1387. 9995 CONTINUE
  1388. 9996 CONTINUE
  1389. SEGSUP MRIGID
  1390. C
  1391. 666 CONTINUE
  1392. MMODEL = IPMODL
  1393. SEGSUP,MMODEL
  1394.  
  1395. END
  1396.  
  1397.  
  1398.  
  1399.  
  1400.  

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