Tיlיcharger rigi1.eso

Retour א la liste

Numיrotation des lignes :

  1. C RIGI1 SOURCE CB215821 19/10/11 21:15:01 10333
  2.  
  3. SUBROUTINE RIGI1(MODORI,IPCHE1,IPCHE2,IMAT, IPOI6,IRET,NOER)
  4. C---------------------------------------------------------------------*
  5. C *
  6. C OPERATEUR RIGIDITE *
  7. C *
  8. C---------------------------------------------------------------------*
  9. C *
  10. C CE SOUS-PROGRAMME SERT A TRAITER ET A METTRE EN FORME *
  11. C LES INFORMATIONS NECESSAIRES POUR LES CALCULS *
  12. C *
  13. C---------------------------------------------------------------------*
  14. C *
  15. C ENTREES : *
  16. C ________ *
  17. C *
  18. C MODORI Pointeur sur le modele *
  19. C IPCHE1 Pointeur sur le chamelem de carateristiques *
  20. C IPCHE2 Pointeur sur le chamelem de matrice de HOOKE *
  21. C IMAT (2 il y a une matrice de HOOKE,1 non ) *
  22. C *
  23. C SORTIES : *
  24. C ________ *
  25. C *
  26. C IPOI6 pointeur sur la rigidite construite *
  27. C IRET (1 OK , 0 erreur ) *
  28. C *
  29. C---------------------------------------------------------------------*
  30. IMPLICIT INTEGER(I-N)
  31. IMPLICIT REAL*8(A-H,O-Z)
  32. C
  33. -INC CCOPTIO
  34. -INC CCHAMP
  35. -INC CCGEOME
  36. -INC CCREEL
  37. C-
  38. -INC SMCHAML
  39. -INC SMINTE
  40. -INC SMELEME
  41. -INC SMRIGID
  42. -INC SMMODEL
  43. -INC SMCOORD
  44. -INC SMLREEL
  45. C
  46. integer oooval
  47.  
  48. SEGMENT INFO
  49. INTEGER INFELL(JG)
  50. ENDSEGMENT
  51.  
  52. POINTEUR NOMID1.NOMID
  53. C
  54. SEGMENT NOTYPE
  55. CHARACTER*16 TYPE(NBTYPE)
  56. ENDSEGMENT
  57. C
  58. SEGMENT MPTVAL
  59. INTEGER IPOS(NS) ,NSOF(NS)
  60. INTEGER IVAL(NCOSOU)
  61. CHARACTER*16 TYVAL(NCOSOU)
  62. ENDSEGMENT
  63. C
  64. segment modsta
  65. integer pimoda(nmoda),pistat(nstat)
  66. integer ivmoda(nmoda),ivstat(nstat)
  67. endsegment
  68. C
  69. CHARACTER*8 CMATE
  70. CHARACTER*(NCONCH) CONM
  71. PARAMETER ( INTTYP=3 )
  72. C INTTYP DEFINIT LE TYPE DE POINTS D'INTEGRATION
  73. C UTILISE PAR RIGI
  74. PARAMETER ( NINF=3 )
  75. INTEGER INFOS(NINF)
  76. LOGICAL LDPGE,lsupfo,lsupdp,lsupma,dcmate,dcmat2
  77. C
  78. C Petit tableau des "couleurs" des relations de conformite (goto 31)
  79. DIMENSION LCOLOR(6)
  80. DATA LCOLOR / 1, 3, 6, 10, 16, 24 /
  81. C
  82. IRET = 0
  83. IPOI6 = 0
  84. C
  85. C ACTIVATION DU MODELE
  86. C --------------------
  87. C MODORI = Modele initial complet
  88. C IPMODL = Modele "deroule" (uniquement "MECANIQUE", "LIQUIDE" ou "POREUX")
  89. CALL PIMODL(MODORI,IPMODL)
  90. IF (IPMODL.EQ.0) RETURN
  91. C IPMODL est ACTIF en retour (nouveau pointeur pouvant etre detruit)
  92. MMODEL= IPMODL
  93. NSOUS = KMODEL(/1)
  94. C
  95. C VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES
  96. C ZZZZZZZZ PEUT ETRE A FAIRE PLUTOT SUR LES SOUS-ZONES
  97. C
  98. ISUP=0
  99. IF (IPCHE1.NE.0)THEN
  100. C reduction
  101. C call zpchel(ipche1,1)
  102. call reduaf(ipche1,MMODEL,ipche10,0,iretca,kerr)
  103. C call zpchel(ipche10,1)
  104. if (iretca.ne.1) call erreur(kerr)
  105. if (ierr.ne.0) goto 889
  106. ipche1=ipche10
  107. CALL QUESUP(MMODEL,IPCHE1,INTTYP,0,ISUP,IRETCA)
  108. IF (ISUP.GT.1) GOTO 889
  109. ENDIF
  110. C
  111. C VERIFICATION DU LIEU SUPPORT DU MCHAML DE HOOKE
  112. C
  113. ISUP1 = 0
  114. IPCHOO = 0
  115. IF (IMAT.EQ.2) THEN
  116. IPCHOO = IPCHE1
  117. IF (IPCHE2.NE.0) THEN
  118. IPCHOO = IPCHE2
  119. call reduaf(IPCHOO,MMODEL,IPCHE2,0,iretca,kerr)
  120. if (iretca.ne.1) call erreur(kerr)
  121. if (ierr .ne.0) goto 889
  122. IPCHOO = IPCHE2
  123. CALL QUESUP(MMODEL,IPCHE2,INTTYP,1,ISUP1,IRETHO)
  124. IF (ISUP1.NE.0) GOTO 889
  125. ENDIF
  126. ENDIF
  127. C
  128. SEGACT MMODEL
  129. C INITIALISATION DU CHAPEAU DE L'OBJET RIGIDITE
  130. C ---------------------------------------------
  131. NRIGEL=0
  132. SEGINI,MRIGID
  133. MTYMAT = 'RIGIDITE'
  134. IFORIG=IFOUR
  135. ICHOLE=0
  136. IMGEO1=0
  137. IMGEO2=0
  138. ISUPEQ=0
  139. C
  140. C termes croises STATIQUE et/ou MODAL
  141. nstat = 100
  142. kstat = 0
  143. nmoda = 100
  144. kmoda = 0
  145. segini modsta
  146. C--------------------------------------------------------------------*
  147. C
  148. C BOUCLE SUR LES ZONES ELEMENTAIRES ( MEME TYPE D'EF )
  149. C
  150. C--------------------------------------------------------------------*
  151. C ETAT ACTUEL DES SEGMENTS : MRIGID ACTIF , MMODEL ACTIF
  152. C IPCHE1 INACTIF, IPCHE2 INACTIF
  153. C
  154. ISOU=0
  155. DO 500 ISOUS=1,NSOUS
  156. C
  157. IMODEL=KMODEL(ISOUS)
  158. SEGACT IMODEL
  159. C
  160. C INITIALISATIONS
  161. C
  162. MELE = NEFMOD
  163. IPMAIL = IMAMOD
  164. CONM = CONMOD
  165. C
  166. IVAMAT=0
  167. IVACAR=0
  168. NMATR=0
  169. NMATF=0
  170. NCARA=0
  171. NCARF=0
  172. MOCARA=0
  173. MOMATR=0
  174. DESCR=0
  175. xMATRI=0
  176. lsupma=.true.
  177. dcmate = .false.
  178. dcmat2 = .false.
  179. IPMINT = 0
  180. IIPDPG = 0
  181. C
  182. IF (MELE.EQ.22) GOTO 310
  183.  
  184. IF (MELE.EQ.259) GOTO 500
  185. C
  186. C COQUE INTEGREE OU PAS ?
  187. C
  188. IF(INFMOD(/1).NE.0)THEN
  189. NPINT=INFMOD(1)
  190. ELSE
  191. NPINT=0
  192. ENDIF
  193. C
  194. C VERIFICATION SUR LA FORMULATION
  195. C
  196. CMATE = CMATEE
  197. MATE = IMATEE
  198. INAT = INATUU
  199. C
  200. do im = 1,matmod(/2)
  201. if (matmod(im).eq.'IMPEDANCE') then
  202. dcmate =.true.
  203. if(tymode(/2).gt.0)then
  204. if(tymode(1).eq.'LISTMOTS') dcmat2 = .true.
  205. endif
  206. endif
  207. enddo
  208. C
  209. C CREATION DU TABLEAU INFOS
  210. C
  211. IRTD=1
  212. CALL IDENT(IPMAIL,CONM,IPCHE2,IPCHE1,INFOS,IRTD)
  213. IF (IRTD.EQ.0) GOTO 518
  214. C
  215. meleme = ipmail
  216. segact meleme
  217. IF (dcmate) THEN
  218. if (itypel.eq.1) mele = 45
  219. if (itypel.eq.2) mele = 2
  220. ENDIF
  221.  
  222. Cרררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררר
  223. C P H A S E 1
  224. C
  225. C INFOS. ELEMENT FINI ET COMPOSANTES NECESSAIRES
  226. C DANS LES CHAMPS EN ENTREE ET EVENTUELLEMENT EN SORTIE
  227. C
  228. C ON POURRAIT REGROUPER LA PLUS GROSSE PARTIE DE CETTE PHASE DANS
  229. C UN SOUS-PROGRAMME COMMUN A BEAUCOUP D'OPERATEURS
  230. C
  231. Cרררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררר
  232. C
  233. if(infmod(/1).lt.2+inttyp) then
  234. CALL ELQUOI(MELE,0,INTTYP,IPINF,IMODEL)
  235. IF ( IERR.NE.0 ) GOTO 888
  236. C
  237. INFO = IPINF
  238. NSTRS = INFELL(16)
  239. MFR = INFELL(13)
  240. LW = INFELL(7)
  241. NDDL = INFELL(15)
  242. IELE = INFELL( 14)
  243. LRE = INFELL(9)
  244. IPORE = INFELL(8)
  245. LHOOK = INFELL(10)
  246. NBPGAU= INFELL( 6)
  247. C ICARA = INFELL( 5)
  248. MINTE = INFELL(11)
  249. MINTE1= INFELL(12)
  250. SEGSUP,INFO
  251. else
  252. NSTRS = INFELE(16)
  253. MFR = INFELE(13)
  254. LW = INFELE(7)
  255. NDDL = INFELE(15)
  256. IELE = INFELE( 14)
  257. LRE = INFELE(9)
  258. IPORE = INFELE(8)
  259. LHOOK = INFELE(10)
  260. NBPGAU= INFELE( 6)
  261. C ICARA = INFELE( 5)
  262. MINTE = INFMOD(2+INTTYP)
  263. MINTE1= INFMOD(8)
  264. endif
  265.  
  266. IPMINT=MINTE
  267. IPMIN1=MINTE1
  268. if((mele.ne.260).or.(mele.ne.259)) SEGACT MINTE
  269.  
  270. CALL INFDPG(MFR,IFOUR,LDPGE,NDPGE)
  271. IF (LDPGE) THEN
  272. IIPDPG = imodel.IPDPGE
  273. IIPDPG = IPTPOI(IIPDPG)
  274. IF (IIPDPG.LE.0) THEN
  275. CALL ERREUR(925)
  276. CALL ERREUR(5)
  277. RETURN
  278. ENDIF
  279. ENDIF
  280.  
  281.  
  282. 310 continue
  283. C Si necessaire partitionnement du xmatri
  284. ipt1=ipmail
  285. segact ipt1
  286. ltrk=oooval(1,4)
  287. if (ltrk.eq.0) ltrk=oooval(1,1)
  288. nbnn1 =ipt1.num(/1)
  289. nbele1=ipt1.num(/2)
  290. c lre : nb de noeuds par mult
  291. if (nefmod.eq.22) lre=nbnn1
  292. c lre : nb de noeuds par sure
  293. if (nefmod.eq.259) lre=nbnn1
  294. C
  295. C traitement particulier pour milieu poreux
  296.  
  297. IPPORE=0
  298. IF(MFR.EQ.33.OR.MFR.EQ.57.OR.MFR.EQ.59) THEN
  299. IPPORE=NBNNE(NUMGEO(MELE))
  300. ENDIF
  301. C
  302. IDECAP=0
  303. IF (MELE.GE.79.AND.MELE.LE.83) THEN
  304. IDECAP=1
  305. LRE = LRE + 2*NBNN1 - IPORE
  306. ELSE IF (MELE.GE.108.AND.MELE.LE.110) THEN
  307. IDECAP=1
  308. LRE = LRE + (3*NBNN1 - IPORE)/2 - NBSOM(IELE)
  309. ELSE IF (MELE.GE.173.AND.MELE.LE.177) THEN
  310. IDECAP=2
  311. LRE = LRE + (2*NBNN1 - IPORE)*IDECAP
  312. LHOOK=4
  313. IF(IFOUR.EQ.1) LHOOK=6
  314. ELSE IF (MELE.GE.185.AND.MELE.LE.187) THEN
  315. IDECAP=2
  316. LRE = LRE + ((3*NBNN1 - IPORE)/2 - NBSOM(IELE))*IDECAP
  317. LHOOK=2
  318. IF(IFOUR.EQ.1) LHOOK=3
  319. ELSE IF (MELE.GE.178.AND.MELE.LE.182) THEN
  320. IDECAP=3
  321. LRE = LRE + (2*NBNN1 - IPORE)*IDECAP
  322. LHOOK=4
  323. IF(IFOUR.EQ.1) LHOOK=6
  324. ELSE IF (MELE.GE.188.AND.MELE.LE.190) THEN
  325. IDECAP=3
  326. LRE = LRE + ((3*NBNN1 - IPORE)/2 - NBSOM(IELE))*IDECAP
  327. LHOOK=2
  328. IF(IFOUR.EQ.1) LHOOK=3
  329. ENDIF
  330.  
  331. C Ajout a la taille en mots de la matrice des infos du segment
  332. lseg = lre*lre*nbele1 + 16
  333. nblprt = (lseg-1)/ltrk+1
  334. nblmax = (nbele1-1)/nblprt+1
  335. nblprt = (nbele1-1)/nblmax+1
  336.  
  337. C write(ioimp,*) 'nblprt nblmax nbele1',nblprt,nblmax,nbele1
  338. meleme = ipt1
  339. nrigel = MRIGID.IRIGEL(/2) + NBLPRT
  340. SEGADJ,MRIGID
  341. IPOI6=MRIGID
  342.  
  343. do 505 iprt=1,nblprt
  344. isou=isou+1
  345. if (nblprt.ne.1) then
  346. segact ipt1
  347. nbsous=0
  348. nbref=0
  349. nbnn=nbnn1
  350. inelem = (iprt-1) * nblmax
  351. nbelem=min(nblmax,nbele1-inelem)
  352. C write(ioimp,*) ' creation segment ',nbnn,nbelem
  353. segini meleme
  354. itypel=ipt1.itypel
  355. do il=1,nbelem
  356. jl = il + inelem
  357. do ip=1,nbnn
  358. num(ip,il)=ipt1.num(ip,jl)
  359. enddo
  360. icolor(il)=ipt1.icolor(jl)
  361. enddo
  362. endif
  363. nbnn=nbnn1
  364. ipmail=meleme
  365.  
  366. IF (MELE.EQ.22) GOTO 9991
  367. IF (MELE.EQ.259) GOTO 9991
  368. C* Cas particulier des elements XFEM en cas de partition :
  369. C* Il faut aussi partitionner le modele (nomme imoxfem)
  370. IF (MFR.EQ.63) THEN
  371. IF (nblprt.GT.1) THEN
  372. imoxfem = 0
  373. CALL PARTXR(IMODEL,ipmail,imoxfem)
  374. ELSE
  375. imoxfem = IMODEL
  376. ENDIF
  377. ENDIF
  378.  
  379. C LHOO2 = LHOOK*LHOOK
  380. C
  381. C SEGMENTS D'INTEGRATION
  382. C
  383. C Minte : 1er segment d'integration, il existe pour tous les e.f.
  384. C Minte1: 2eme segment d'integration, uniquement pour certains e.f.
  385. C en particulier pour Coq6 et Coq8
  386. C nbpg:nb de points de gauss = nbpgau du segment minte
  387. C iele:no d'element geometrique associe a l'e.f. mele
  388. C nbff:nb de fonctions de forme = nbno du segment minte
  389. C
  390. C TRAITEMENT DES CHAMPS EN ENTREE
  391. C -------------------------------
  392. C
  393. C >>> CHAMP DE MATRICES DE HOOKE
  394. C
  395. IF (IMAT.EQ.2) THEN
  396. IF(MELE.EQ.93.AND.CMATE.NE.'ISOTROPE')THEN
  397. NBROBL=3
  398. NBRFAC=0
  399. SEGINI NOMID
  400. LESOBL(1)='MAHO'
  401. LESOBL(2)='V1X '
  402. LESOBL(3)='V1Y '
  403. NBTYPE=3
  404. SEGINI NOTYPE
  405. TYPE(1)='POINTEURLISTREEL'
  406. TYPE(2)='REAL*8'
  407. TYPE(3)='REAL*8'
  408.  
  409. ELSE
  410. NBROBL =1
  411. NBRFAC =0
  412. SEGINI NOMID
  413. LESOBL(1)='MAHO'
  414. NBTYPE =1
  415. SEGINI NOTYPE
  416. TYPE(1) ='POINTEURLISTREEL'
  417. ENDIF
  418.  
  419. MOMATR=NOMID
  420. MOTYPE=NOTYPE
  421. NMATR =NBROBL
  422. NMATF =NBRFAC
  423. C
  424. CALL KOMCHA(IPCHOO,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  425. SEGSUP NOTYPE
  426. IF (IERR.NE.0) GOTO 9991
  427. C
  428. MPTVAL=IVAMAT
  429. MELVAL=IVAL(1)
  430. NBGMAT=IELCHE(/1)
  431. NELMAT=IELCHE(/2)
  432. NMATT=NMATR+NMATF
  433. IF(IPCHE2.EQ.0.AND.ISUP.EQ.1)THEN
  434. CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  435. IF(IERR.NE.0)THEN
  436. ISUP=0
  437. GOTO 9991
  438. ENDIF
  439. ENDIF
  440.  
  441. ELSE
  442. C
  443. C >>> CHAMP DE MATERIAU
  444. C
  445. IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'ISOTROPE') THEN
  446. NBROBL=2
  447. NBRFAC=0
  448. SEGINI NOMID
  449. MOMATR=NOMID
  450. IF (MFR.EQ.35.or.mfr.eq.78) THEN
  451. LESOBL(1)='KS '
  452. LESOBL(2)='KN '
  453. ELSE IF(MFR.EQ.53) THEN
  454. NBROBL=1
  455. SEGADJ,NOMID
  456. LESOBL(1)='KS '
  457. ELSE
  458. LESOBL(1)='YOUN'
  459. LESOBL(2)='NU '
  460. ENDIF
  461. NMATR=NBROBL
  462. NMATF=NBRFAC
  463. ELSE
  464. $ IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'UNIDIREC') THEN
  465. IF (MFR.EQ.1.AND.IDIM.EQ.3) THEN
  466. NBROBL=7
  467. NBRFAC=0
  468. SEGINI NOMID
  469. MOMATR=NOMID
  470. LESOBL(1)='YOUN'
  471. LESOBL(2)='V1X '
  472. LESOBL(3)='V1Y '
  473. LESOBL(4)='V1Z '
  474. LESOBL(5)='V2X '
  475. LESOBL(6)='V2Y '
  476. LESOBL(7)='V2Z '
  477. ELSE
  478. NBROBL=3
  479. NBRFAC=0
  480. SEGINI NOMID
  481. MOMATR=NOMID
  482. LESOBL(1)='YOUN'
  483. LESOBL(2)='V1X '
  484. LESOBL(3)='V1Y '
  485. ENDIF
  486. NMATR=NBROBL
  487. NMATF=NBRFAC
  488. ELSE
  489. $ IF (FORMOD(1).EQ.'MECANIQUE'
  490. $ .AND.CMATE.EQ.'ZONE_COHESIVE') THEN
  491. IF (MFR.EQ.77) THEN
  492. NBROBL=2
  493. NBRFAC=0
  494. SEGINI NOMID
  495. MOMATR=NOMID
  496. LESOBL(1)='KS '
  497. LESOBL(2)='KN '
  498. ENDIF
  499. NMATR=NBROBL
  500. NMATF=NBRFAC
  501. ELSE
  502. $ IF (FORMOD(1).EQ.'POREUX '.AND.CMATE.EQ.'ISOTROPE') THEN
  503. IF (MELE.GE.79.AND.MELE.LE.83) THEN
  504. NBROBL=4
  505. NBRFAC=0
  506. SEGINI NOMID
  507. MOMATR=NOMID
  508. LESOBL(1)='YOUN'
  509. LESOBL(2)='NU '
  510. LESOBL(3)='COB '
  511. LESOBL(4)='MOB '
  512. ELSE IF (MELE.GE.108.AND.MELE.LE.110) THEN
  513. NBROBL=4
  514. NBRFAC=0
  515. SEGINI NOMID
  516. MOMATR=NOMID
  517. LESOBL(1)='KS '
  518. LESOBL(2)='KN '
  519. LESOBL(3)='COB '
  520. LESOBL(4)='MOB '
  521. ELSE IF (MELE.GE.173.AND.MELE.LE.177) THEN
  522. NBROBL=10
  523. NBRFAC=0
  524. SEGINI NOMID
  525. MOMATR=NOMID
  526. LESOBL(1)='YOUN'
  527. LESOBL(2)='NU '
  528. LESOBL(3)='COP1'
  529. LESOBL(4)='COP2'
  530. LESOBL(5)='CPP1'
  531. LESOBL(6)='CPP2'
  532. LESOBL(7)='KK11'
  533. LESOBL(8)='KK12'
  534. LESOBL(9)='KK21'
  535. LESOBL(10)='KK22'
  536. ELSE IF (MELE.GE.178.AND.MELE.LE.182) THEN
  537. NBROBL=17
  538. NBRFAC=0
  539. SEGINI NOMID
  540. MOMATR=NOMID
  541. LESOBL(1)='YOUN'
  542. LESOBL(2)='NU '
  543. LESOBL(3)='COP1'
  544. LESOBL(4)='COP2'
  545. LESOBL(5)='COP3'
  546. LESOBL(6)='CPP1'
  547. LESOBL(7)='CPP2'
  548. LESOBL(8)='CPP3'
  549. LESOBL(9)='KK11'
  550. LESOBL(10)='KK12'
  551. LESOBL(11)='KK13'
  552. LESOBL(12)='KK21'
  553. LESOBL(13)='KK22'
  554. LESOBL(14)='KK23'
  555. LESOBL(15)='KK31'
  556. LESOBL(16)='KK32'
  557. LESOBL(17)='KK33'
  558. ELSE IF (MELE.GE.185.AND.MELE.LE.187) THEN
  559. NBROBL=10
  560. NBRFAC=0
  561. SEGINI NOMID
  562. MOMATR=NOMID
  563. LESOBL(1)='KS '
  564. LESOBL(2)='KN '
  565. LESOBL(3)='COP1'
  566. LESOBL(4)='COP2'
  567. LESOBL(5)='CPP1'
  568. LESOBL(6)='CPP2'
  569. LESOBL(7)='KK11'
  570. LESOBL(8)='KK12'
  571. LESOBL(9)='KK21'
  572. LESOBL(10)='KK22'
  573. ELSE IF (MELE.GE.188.AND.MELE.LE.190) THEN
  574. NBROBL=17
  575. NBRFAC=0
  576. SEGINI NOMID
  577. MOMATR=NOMID
  578. LESOBL(1)='KS '
  579. LESOBL(2)='KN '
  580. LESOBL(3)='COP1'
  581. LESOBL(4)='COP2'
  582. LESOBL(5)='COP3'
  583. LESOBL(6)='CPP1'
  584. LESOBL(7)='CPP2'
  585. LESOBL(8)='CPP3'
  586. LESOBL(9)='KK11'
  587. LESOBL(10)='KK12'
  588. LESOBL(11)='KK13'
  589. LESOBL(12)='KK21'
  590. LESOBL(13)='KK22'
  591. LESOBL(14)='KK23'
  592. LESOBL(15)='KK31'
  593. LESOBL(16)='KK32'
  594. LESOBL(17)='KK33'
  595. ENDIF
  596. NMATR=NBROBL
  597. NMATF=NBRFAC
  598. C
  599. ELSEIF(INAT.EQ.67.AND.CMATE.EQ.'ORTHOTRO') THEN
  600. NBROBL=6
  601. NBRFAC=0
  602. SEGINI NOMID
  603. MOMATR=NOMID
  604. LESOBL(1)='YG1 '
  605. LESOBL(2)='YG2 '
  606. LESOBL(3)='NU12'
  607. LESOBL(4)='G12 '
  608. LESOBL(5)='V1X '
  609. LESOBL(6)='V1Y '
  610. NMATR=NBROBL
  611. NMATF=NBRFAC
  612. C
  613. C ELSE IF (FORMOD(1).EQ.'ELECTROSTATIQUE') THEN
  614. C Pour l'instant, lnomid(6) ou appel a IDMATR suffisent.
  615. C
  616. ELSE IF (FORMOD(1).EQ.'DIFFUSION') THEN
  617. C CB215821 : Desormais il faut utiliser COND
  618. CALL ERREUR(5)
  619. RETURN
  620. C CALL IDDILI(MATE,1,MOMATR,NMATR,NMATF)
  621. C nomid = momatr
  622. C segact nomid
  623. C
  624. C Autres cas :
  625. ELSE
  626. if(lnomid(6).ne.0) then
  627. lsupma=.false.
  628. momatr = lnomid(6)
  629. else
  630. CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  631. endif
  632. nomid = momatr
  633. segact nomid
  634. nmatr=lesobl(/2)
  635. nmatf=lesfac(/2)
  636. ENDIF
  637. C
  638. IF (CMATE.EQ.'SECTION') THEN
  639. NBTYPE=3
  640. SEGINI NOTYPE
  641. TYPE(1)='POINTEURMMODEL'
  642. TYPE(2)='POINTEURMCHAML'
  643. TYPE(3)='POINTEURLISTREEL'
  644. c mistral :
  645. ELSEIF (INAT.EQ.94) THEN
  646. NBTYPE=NMATR+NMATF
  647. SEGINI NOTYPE
  648. DO 11 ITYP=1,NBTYPE
  649. TYPE(ITYP)='REAL*8'
  650. 11 CONTINUE
  651. C pour le modטle mistral il y a 10 composantes non linיaires qui sont des listes de rיels
  652. NLDEB=NMATR-9
  653. DO 13 ITYP=NLDEB,NMATR
  654. TYPE(ITYP)='POINTEURLISTREEL'
  655. 13 CONTINUE
  656. C mistral.
  657. C
  658. C poi1 -- MODAL
  659. C
  660. ELSE IF (CMATE.EQ.'MODAL') THEN
  661. NBROBL=3
  662. NBRFAC=0
  663. SEGINI NOMID
  664. MOMATR=NOMID
  665. LESOBL(1)='FREQ'
  666. LESOBL(2)='MASS'
  667. LESOBL(3)='DEFO'
  668. C
  669. NBTYPE=3
  670. SEGINI NOTYPE
  671. MOTYPE=NOTYPE
  672. TYPE(1)='REAL*8'
  673. TYPE(2)='REAL*8'
  674. TYPE(3)='POINTEURCHPOINT'
  675. C
  676. C poi1 -- STATIQUE
  677. C
  678. ELSE IF (CMATE.EQ.'STATIQUE') THEN
  679. NBROBL=3
  680. NBRFAC=0
  681. SEGINI NOMID
  682. MOMATR=NOMID
  683. LESOBL(1)='DEFO'
  684. LESOBL(2)='RIDE'
  685. LESOBL(3)='MADE'
  686. C
  687. NBTYPE=1
  688. SEGINI NOTYPE
  689. MOTYPE=NOTYPE
  690. TYPE(1)='POINTEURCHPOINT'
  691. C
  692. C IMPEDANCE COMPLEXE
  693. C
  694. ELSE IF (CMATE.EQ.'IMPCOMPL') THEN
  695. NBROBL=1
  696. NBRFAC=0
  697. SEGINI NOMID
  698. MOMATR=NOMID
  699. LESOBL(1)='RAID'
  700. C
  701. NBTYPE=1
  702. SEGINI NOTYPE
  703. MOTYPE=NOTYPE
  704. TYPE(1)='REAL*8'
  705. C
  706. ELSE
  707. NBTYPE=1
  708. SEGINI NOTYPE
  709. TYPE(1)='REAL*8'
  710. ENDIF
  711. MOTYPE=NOTYPE
  712. C
  713. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  714. SEGSUP NOTYPE
  715. IF (IERR.NE.0) GOTO 9991
  716. NMATT=NMATR+NMATF
  717. IF(ISUP.EQ.1)THEN
  718. CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  719. IF(IERR.NE.0)THEN
  720. ISUP=0
  721. GOTO 9991
  722. ENDIF
  723. ENDIF
  724. C
  725. MPTVAL=IVAMAT
  726. SEGACT,MPTVAL
  727. C
  728. if (cmate.eq.'STATIQUE'.or.cmate.eq.'MODAL') then
  729. if (ival(/1).lt.3) call erreur(5)
  730. if (cmate.eq.'STATIQUE') then
  731. kstat = kstat + 1
  732. ivstat(kstat) = ivamat
  733. pistat(kstat) = imodel
  734. if (kstat.eq.nstat) then
  735. nstat = nstat + 100
  736. segadj modsta
  737. endif
  738. else if (cmate.eq.'MODAL') then
  739. kmoda = kmoda + 1
  740. ivmoda(kmoda) = ivamat
  741. pimoda(kmoda) = imodel
  742. if (kmoda.eq.nmoda) then
  743. nmoda = nmoda + 100
  744. segadj modsta
  745. endif
  746. endif
  747. endif
  748. C
  749. NBGMAT = 0
  750. NELMAT = 0
  751. DO 1108 IM=1,ival(/1)
  752. IF(IVAL(IM).NE.0)THEN
  753. MELVAL=IVAL(IM)
  754. IF (CMATE.EQ.'SECTION') THEN
  755. NBGMAT=MAX(NBGMAT,IELCHE(/1))
  756. NELMAT=MAX(NELMAT,IELCHE(/2))
  757. ELSE
  758. NBGMAT=MAX(NBGMAT,VELCHE(/1))
  759. NELMAT=MAX(NELMAT,VELCHE(/2))
  760. ENDIF
  761. ENDIF
  762. 1108 CONTINUE
  763. ENDIF
  764. C
  765. C >>> CHAMPS DE CARACTERISTIQUES
  766. C
  767. NBROBL=0
  768. NBRFAC=0
  769. MOCARA=0
  770. IVECT=0
  771. C
  772. C EPAISSEUR DANS LE CAS MASSIF EN CONTRAINTES PLANES
  773. C
  774. C ccccccc
  775. IF((MFR.EQ.1.OR.MFR.EQ.31.OR.
  776. C ccccccc
  777. + ((MELE.GE.79.AND.MELE.LE.83).OR.
  778. + (MELE.GE.173.AND.MELE.LE.182)))
  779. + .AND.IFOUR.EQ.-2)THEN
  780. NBROBL=0
  781. NBRFAC=1
  782. SEGINI NOMID
  783. MOCARA=NOMID
  784. LESFAC(1)='DIM3'
  785. C
  786. NBTYPE=1
  787. SEGINI NOTYPE
  788. MOTYPE=NOTYPE
  789. TYPE(1)='REAL*8'
  790. C
  791. C EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES
  792. C
  793. ELSEIF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  794. NBROBL=1
  795. IF(MFR.EQ.3.AND.IFOUR.EQ.-2) THEN
  796. NBRFAC=2
  797. ELSE
  798. NBRFAC=1
  799. ENDIF
  800. SEGINI NOMID
  801. MOCARA=NOMID
  802. LESOBL(1)='EPAI'
  803. LESFAC(1)='EXCE'
  804. IF(MFR.EQ.3.AND.IFOUR.EQ.-2) LESFAC(2)='DIM3'
  805. C
  806. NBTYPE=1
  807. SEGINI NOTYPE
  808. MOTYPE=NOTYPE
  809. TYPE(1)='REAL*8'
  810. C
  811. C SECTION POUR LES BARRES ET LES CERCES
  812. C
  813. ELSE IF (MFR.EQ.27.OR.MFR.EQ.78) THEN
  814. IF(.NOT.dcmate) THEN
  815. NBROBL=1
  816. SEGINI NOMID
  817. MOCARA=NOMID
  818. LESOBL(1)='SECT'
  819. C
  820. NBTYPE=1
  821. SEGINI NOTYPE
  822. MOTYPE=NOTYPE
  823. TYPE(1)='REAL*8'
  824. ENDIF
  825. C
  826. C section, excentrements et orientation pour les barres excentrees
  827. C
  828. ELSE IF (MFR.EQ.49) THEN
  829. NBROBL=6
  830. SEGINI NOMID
  831. MOCARA=NOMID
  832. LESOBL(1)='SECT'
  833. LESOBL(2)='EXCZ'
  834. LESOBL(3)='EXCY'
  835. LESOBL(4)='VX '
  836. LESOBL(5)='VY '
  837. LESOBL(6)='VZ '
  838. C
  839. NBTYPE=1
  840. SEGINI NOTYPE
  841. MOTYPE=NOTYPE
  842. TYPE(1)='REAL*8'
  843. C
  844. C raideurs locales et orientation pour l'element LIA2
  845. C de liaison a 2 noeuds
  846. C
  847. ELSE IF (MFR.EQ.51) THEN
  848. NBROBL=9
  849. SEGINI NOMID
  850. MOCARA=NOMID
  851. LESOBL(1)='RLUX'
  852. LESOBL(2)='RLUY'
  853. LESOBL(3)='RLUZ'
  854. LESOBL(4)='RLRX'
  855. LESOBL(5)='RLRY'
  856. LESOBL(6)='RLRZ'
  857. LESOBL(7)='VX '
  858. LESOBL(8)='VY '
  859. LESOBL(9)='VZ '
  860. C
  861. NBTYPE=1
  862. SEGINI NOTYPE
  863. MOTYPE=NOTYPE
  864. TYPE(1)='REAL*8'
  865. C
  866. C CARACTERISTIQUES POUR LES POUTRES
  867. C
  868. ELSE IF (MFR.EQ.7 ) THEN
  869. if (dcmate) then
  870. NBROBL=0
  871. NBRFAC=4
  872. SEGINI NOMID
  873. MOCARA=NOMID
  874. LESFAC(1)='TORS'
  875. LESFAC(2)='INRY'
  876. LESFAC(3)='INRZ'
  877. LESFAC(4)='VECT'
  878. IVECT=1
  879. C
  880. NBTYPE=4
  881. SEGINI NOTYPE
  882. MOTYPE=NOTYPE
  883. TYPE(1)='REAL*8'
  884. TYPE(2)='REAL*8'
  885. TYPE(3)='REAL*8'
  886. TYPE(4)='POINTEURPOINT '
  887. else
  888. IF (CMATE.EQ.'SECTION') THEN
  889. NBROBL=0
  890. NBRFAC=1
  891. SEGINI NOMID
  892. MOCARA=NOMID
  893. LESFAC='VECT'
  894. IVECT=1
  895. C
  896. NBTYPE=1
  897. SEGINI NOTYPE
  898. MOTYPE=NOTYPE
  899. TYPE(1)='POINTEURPOINT '
  900. C
  901. C CAS 2D
  902. ELSE IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  903. NBRFAC=1
  904. NBROBL=2
  905. SEGINI NOMID
  906. MOCARA=NOMID
  907. LESOBL(1)= 'SECT'
  908. LESOBL(2)= 'INRZ'
  909. LESFAC(1)= 'SECY'
  910. C
  911. NBTYPE=1
  912. SEGINI NOTYPE
  913. MOTYPE=NOTYPE
  914. TYPE(1)='REAL*8'
  915. C
  916. ELSE
  917. NBROBL=4
  918. NBRFAC=3
  919. SEGINI NOMID
  920. MOCARA=NOMID
  921. LESOBL(1)='TORS'
  922. LESOBL(2)='INRY'
  923. LESOBL(3)='INRZ'
  924. LESOBL(4)='SECT'
  925. LESFAC(1)='SECY'
  926. LESFAC(2)='SECZ'
  927. LESFAC(3)='VECT'
  928. IVECT=1
  929. C
  930. NBTYPE=7
  931. SEGINI NOTYPE
  932. MOTYPE=NOTYPE
  933. TYPE(1)='REAL*8'
  934. TYPE(2)='REAL*8'
  935. TYPE(3)='REAL*8'
  936. TYPE(4)='REAL*8'
  937. TYPE(5)='REAL*8'
  938. TYPE(6)='REAL*8'
  939. TYPE(7)='POINTEURPOINT '
  940. ENDIF
  941. endif
  942. C
  943. C CARACTERISTIQUES POUR LES TUYAUX
  944. C
  945. ELSE IF (MFR.EQ.13) THEN
  946. NBROBL=2
  947. NBRFAC=4
  948. SEGINI NOMID
  949. MOCARA=NOMID
  950. LESOBL(1)='EPAI'
  951. LESOBL(2)='RAYO'
  952. LESFAC(1)='RACO'
  953. LESFAC(2)='PRES'
  954. LESFAC(3)='CISA'
  955. LESFAC(4)='VECT'
  956. IVECT=1
  957. C
  958. NBTYPE=6
  959. SEGINI NOTYPE
  960. MOTYPE=NOTYPE
  961. TYPE(1)='REAL*8'
  962. TYPE(2)='REAL*8'
  963. TYPE(3)='REAL*8'
  964. TYPE(4)='REAL*8'
  965. TYPE(5)='REAL*8'
  966. TYPE(6)='POINTEURPOINT '
  967. C
  968. ELSE IF (MFR.EQ.39) THEN
  969. NBROBL=2
  970. NBRFAC=3
  971. SEGINI NOMID
  972. MOCARA=NOMID
  973. LESOBL(1)='EPAI'
  974. LESOBL(2)='RAYO'
  975. LESFAC(1)='RACO'
  976. LESFAC(2)='PRES'
  977. LESFAC(3)='VECT'
  978. IVECT=1
  979. C
  980. NBTYPE=5
  981. SEGINI NOTYPE
  982. MOTYPE=NOTYPE
  983. TYPE(1)='REAL*8'
  984. TYPE(2)='REAL*8'
  985. TYPE(3)='REAL*8'
  986. TYPE(4)='REAL*8'
  987. TYPE(5)='POINTEURPOINT '
  988. C
  989. C CARACTERISTIQUES POUR LES LINESPRING
  990. C
  991. ELSE IF (MFR.EQ.15) THEN
  992. NBROBL=5
  993. SEGINI NOMID
  994. MOCARA=NOMID
  995. LESOBL(1)='EPAI'
  996. LESOBL(2)='FISS'
  997. LESOBL(3)='VX '
  998. LESOBL(4)='VY '
  999. LESOBL(5)='VZ '
  1000. C
  1001. NBTYPE=1
  1002. SEGINI NOTYPE
  1003. MOTYPE=NOTYPE
  1004. TYPE(1)='REAL*8'
  1005. C
  1006. C CARACTERISTIQUES POUR LES TUYAUX FISSURES
  1007. C
  1008. ELSE IF (MFR.EQ.17) THEN
  1009. NBROBL=9
  1010. SEGINI NOMID
  1011. MOCARA=NOMID
  1012. LESOBL(1)='RAYO'
  1013. LESOBL(2)='EPAI'
  1014. LESOBL(3)='VX '
  1015. LESOBL(4)='VY '
  1016. LESOBL(5)='VZ '
  1017. LESOBL(6)='VXF '
  1018. LESOBL(7)='VYF '
  1019. LESOBL(8)='VZF '
  1020. LESOBL(9)='ANGL'
  1021. C
  1022. NBTYPE=1
  1023. SEGINI NOTYPE
  1024. MOTYPE=NOTYPE
  1025. TYPE(1)='REAL*8'
  1026. C
  1027. C CARACTERISTIQUES DES ELEMENTS HOMOGENEISES
  1028. C
  1029. ELSE IF (MFR.EQ.37) THEN
  1030. IF(IFOUR.EQ.1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.2) THEN
  1031. NBROBL=5
  1032. SEGINI NOMID
  1033. MOCARA=NOMID
  1034. LESOBL(1)='SCEL'
  1035. LESOBL(2)='SFLU'
  1036. LESOBL(3)='EPS '
  1037. LESOBL(4)='SECT'
  1038. LESOBL(5)='INRZ '
  1039. ELSE
  1040. NBROBL=3
  1041. SEGINI NOMID
  1042. MOCARA=NOMID
  1043. LESOBL(1)='SCEL'
  1044. LESOBL(2)='SFLU'
  1045. LESOBL(3)='EPS '
  1046. ENDIF
  1047. C
  1048. NBTYPE=1
  1049. SEGINI NOTYPE
  1050. MOTYPE=NOTYPE
  1051. TYPE(1)='REAL*8'
  1052. C
  1053. C CARACTERISTIQUES DE L'ELEMENT TUYAU ACOUSTIQUE
  1054. C
  1055. ELSE IF (MFR.EQ.41) THEN
  1056. NBROBL=1
  1057. NBRFAC=1
  1058. SEGINI NOMID
  1059. MOCARA=NOMID
  1060. LESOBL(1)='RAYO'
  1061. LESFAC(1)='RACO'
  1062. C
  1063. NBTYPE=1
  1064. SEGINI NOTYPE
  1065. MOTYPE=NOTYPE
  1066. TYPE(1)='REAL*8'
  1067. C
  1068. C CARACTERISTIQUE POUR LES JOINTS GENE
  1069. C
  1070. ELSE IF (MFR.EQ.55) THEN
  1071. CcPPj NBROBL=1
  1072. CcPPj NBRFAC=0
  1073. CcPPj SEGINI NOMID
  1074. CcPPj MOCARA=NOMID
  1075. CcPPj LESOBL(1)='EPAI'
  1076. NBROBL=0
  1077. NBRFAC=1
  1078. SEGINI NOMID
  1079. MOCARA=NOMID
  1080. LESFAC(1)='EPAI'
  1081. C
  1082. NBTYPE=1
  1083. SEGINI NOTYPE
  1084. MOTYPE=NOTYPE
  1085. TYPE(1)='REAL*8'
  1086. C
  1087. C CARACTERISTIQUE MACRO_EL (element CIFL)
  1088. C
  1089. ELSE IF (MFR.EQ.61)THEN
  1090. NBRFAC=0
  1091. NBROBL=2
  1092. SEGINI NOMID
  1093. MOCARA=NOMID
  1094. LESOBL(1)= 'SECT'
  1095. LESOBL(2)= 'INRZ'
  1096. C
  1097. NBTYPE=1
  1098. SEGINI NOTYPE
  1099. MOTYPE=NOTYPE
  1100. TYPE(1)='REAL*8'
  1101. C
  1102. C CARACTERISTIQUES POUR LE JOI1 SI IMAT = 2
  1103. C
  1104. ELSE IF(MFR.EQ.75.AND.IMAT.EQ.2) THEN
  1105. IF(IDIM.EQ.2) THEN
  1106. NBROBL=2
  1107. NBRFAC=0
  1108. SEGINI NOMID
  1109. MOCARA=NOMID
  1110. LESOBL(1)='V1X '
  1111. LESOBL(2)='V1Y '
  1112. NBTYPE=1
  1113. SEGINI NOTYPE
  1114. MOTYPE=NOTYPE
  1115. TYPE(1)='REAL*8'
  1116. ELSE IF(IDIM.EQ.3) THEN
  1117. NBROBL=6
  1118. NBRFAC=0
  1119. SEGINI NOMID
  1120. MOCARA=NOMID
  1121. LESOBL(1)='V1X '
  1122. LESOBL(2)='V1Y '
  1123. LESOBL(3)='V1Z '
  1124. LESOBL(4)='V2X '
  1125. LESOBL(5)='V2Y '
  1126. LESOBL(6)='V2Z '
  1127. NBTYPE=1
  1128. SEGINI NOTYPE
  1129. MOTYPE=NOTYPE
  1130. TYPE(1)='REAL*8'
  1131. ENDIF
  1132. ENDIF
  1133. C
  1134. C rendement kich 09/01
  1135. if (notype.le.0) then
  1136. nbtype = 0
  1137. segini notype
  1138. motype = notype
  1139. nbrobl = 0
  1140. nbrfac = 0
  1141. segini nomid
  1142. mocara = nomid
  1143. endif
  1144.  
  1145. ifac = nbrfac
  1146. NCAR1=NBROBL + NBRFAC + 1
  1147. NBRFAC= nbrfac + 10
  1148. segadj nomid
  1149. lesfac(ifac + 1) = 'REND'
  1150. lesfac(ifac + 2) = 'W1X '
  1151. lesfac(ifac + 3) = 'W1Y '
  1152. lesfac(ifac + 4) = 'W1Z '
  1153. lesfac(ifac + 5) = 'W2X '
  1154. lesfac(ifac + 6) = 'W2Y '
  1155. lesfac(ifac + 7) = 'W2Z '
  1156. lesfac(ifac + 8) = 'REN1'
  1157. lesfac(ifac + 9) = 'REN2'
  1158. lesfac(ifac + 10) = 'REN3'
  1159. NCARA=NBROBL
  1160. NCARF=NBRFAC
  1161. NCARR=NCARA+NCARF
  1162. nbtype = nbtype + 1
  1163. segadj notype
  1164. type(nbtype) = 'REAL*8'
  1165. C
  1166. IF (IPCHE1.NE.0.AND.MOCARA.NE.0) THEN
  1167. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,IVACAR)
  1168. SEGSUP NOTYPE
  1169. IF (IERR.NE.0) GOTO 9991
  1170. C
  1171. IF (ISUP.EQ.1) THEN
  1172. CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  1173. IF(IERR.NE.0)THEN
  1174. ISUP=0
  1175. GOTO 9991
  1176. ENDIF
  1177. ENDIF
  1178. ELSE
  1179. SEGSUP NOTYPE
  1180. ENDIF
  1181. *
  1182. * AM 11/06/16 VERIFICATION DE LA PRESENCE DES CARACTERTISTIQUES
  1183. * POUR LES ELEMENTS TYPE POUTRE ET ASSIMILES
  1184. * NECESSAIRE AUSSI EN CAS DE MATRICE DE HOOKE
  1185.  
  1186. IF(MELE.EQ.29.OR.MELE.EQ.42.OR.MELE.EQ.84
  1187. & .OR.MELE.EQ.97) THEN
  1188. IF (IVACAR.EQ.0) THEN
  1189. CALL ERREUR (404)
  1190. GO TO 9991
  1191. ENDIF
  1192. ENDIF
  1193.  
  1194. IF(MFR.EQ.75.AND.IMAT.EQ.2.AND.IVACAR.EQ.0) THEN
  1195. CALL ERREUR (404)
  1196. GO TO 9991
  1197. ENDIF
  1198. *
  1199. C
  1200. C utiliser la densite pour ponderer par la prop de phase
  1201. C write (6,*) ' rigi1 conmod ',conmod
  1202. IF (conmod(17:24).NE.' ') THEN
  1203. C rechercher le melval
  1204. iptm = 0
  1205. MCHELM = IPCHE1
  1206. segact MCHELM
  1207. do ima = 1,imache(/1)
  1208. C write (6,*) ' rigi1 ima imache imamod ',ima,imache,imamod
  1209. if (imache(ima).eq.imamod) then
  1210. mchaml = ichaml(ima)
  1211. segact mchaml
  1212. do ic = 1,nomche(/2)
  1213. C write (6,*) ' rigi1 ima ic nomche ',ima,ic,nomche
  1214. if (nomche(ic)(1:4).eq.conmod(17:20)) then
  1215. iptm = ielval (ic)
  1216. C segdes mchaml
  1217. C segdes mchelm
  1218. goto 20
  1219. endif
  1220. enddo
  1221. C segdes mchaml
  1222. endif
  1223. enddo
  1224. C segdes mchelm
  1225. C avertissement
  1226. 20 if (iptm.eq.0)
  1227. & write(6,*) ' proportion phase non trouvee ',conmod(17:24)
  1228. C ponderation
  1229. if (iptm.gt.0) then
  1230. if(ivacar.ne.0) then
  1231. mptval = ivacar
  1232. segact mptval*mod
  1233. if (ival(ncar1).gt.0) then
  1234. melva1 = ival(ncar1)
  1235. melva2 = iptm
  1236. segact melva1,melva2
  1237. n1ptel = max(melva1.velche(/1),melva2.velche(/1))
  1238. n1el = max(melva1.velche(/2),melva2.velche(/2))
  1239. n2ptel = melva1.ielche(/1)
  1240. n2el = melva1.ielche(/2)
  1241. segini melval
  1242. do jptel = 1,n1ptel
  1243. do jel = 1,n1el
  1244. i1 = min(jptel,melva1.velche(/1))
  1245. j1 = min(jel,melva1.velche(/2))
  1246. i2 = min(jptel,melva2.velche(/1))
  1247. j2 = min(jel,melva2.velche(/2))
  1248. velche(jptel,jel) = melva1.velche(i1,j1)*melva2.velche(i2,j2)
  1249. enddo
  1250. enddo
  1251. ival(ncar1) = melval
  1252. C segdes melva1,melva2
  1253. else if (ival(ncar1+7).gt.0.or.ival(ncar1+8).gt.0.or.
  1254. & ival(ncar1+9).gt.0) then
  1255. else
  1256. ival(ncar1) = iptm
  1257. tyval(ncar1) = 'REAL*8'
  1258. melval = iptm
  1259. segact melval
  1260. endif
  1261.  
  1262. endif
  1263. endif
  1264. ENDIF
  1265. C
  1266. C cas particuliers des XFEM
  1267. IF (MFR.EQ.63) GOTO 63
  1268.  
  1269. Cרררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררר
  1270. C P H A S E 2
  1271. C
  1272. C PREPARATION DES OBJETS RESULTATS
  1273. C
  1274. Cרררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררר
  1275. C
  1276. MELEME=IPMAIL
  1277. SEGACT MELEME
  1278. C
  1279. C MODIFICATION DU MELEME POUR LE REMPLISSAGE DU SEGMENT DESCRIPTEUR
  1280. C
  1281. IF (LDPGE) THEN
  1282. IPT3=meleme
  1283. SEGACT IPT3
  1284. NBELEM=NUM(/2)
  1285. NBNN=IPT3.NUM(/1)+1
  1286. NBREF=0
  1287. NBSOUS=0
  1288. SEGINI MELEME
  1289. DO 1007 I=1,NBELEM
  1290. DO 1008 J=1,NBNN-1
  1291. NUM(J,I)=IPT3.NUM(J,I)
  1292. 1008 CONTINUE
  1293. NUM(NBNN,I)=IIPDPG
  1294. 1007 CONTINUE
  1295. ITYPEL=28
  1296. ICOLOR=IPT3.ICOLOR
  1297. IPMADG=MELEME
  1298. C SEGDES IPT3
  1299. ELSE
  1300. NBNN=NUM(/1)
  1301. NBELEM=NUM(/2)
  1302. ENDIF
  1303.  
  1304. C RECHERCHE DES NOMS D'INCONNUES ET DES DUAUX
  1305. C
  1306. NLIGRP= LRE
  1307. NLIGRD= LRE
  1308. SEGINI DESCR
  1309. IPDSCR=DESCR
  1310. if(lnomid(1).ne.0) then
  1311. nomid=lnomid(1)
  1312. segact nomid
  1313. modepl=nomid
  1314. ndepl=lesobl(/2)
  1315. ndum=lesfac(/2)
  1316. lsupdp=.false.
  1317. else
  1318. lsupdp=.true.
  1319. CALL IDPRIM(IMODEL,MFR,MODEPL,NDEPL,NDUM)
  1320. endif
  1321. if(lnomid(2).ne.0) then
  1322. nomid=lnomid(2)
  1323. segact nomid
  1324. moforc=nomid
  1325. nforc=lesobl(/2)
  1326. lsupfo=.false.
  1327. else
  1328. lsupfo=.true.
  1329. CALL IDDUAL(IMODEL,MFR,MOFORC,NFORC,NDUM)
  1330. endif
  1331. C
  1332. IF (NDEPL.EQ.0.OR.NFORC.EQ.0.OR.NDEPL.NE.NFORC) THEN
  1333. CALL ERREUR(5)
  1334. SEGSUP DESCR,MRIGID
  1335. C SEGDES MMODEL,MELEME
  1336. RETURN
  1337. ENDIF
  1338. C
  1339. C REMPLISSAGE DU SEGMENT DESCRIPTEUR
  1340. C
  1341. IDDL=1
  1342. NCOMP=NDEPL
  1343. NBNNS=NBNN
  1344. IF (MFR.EQ.33.OR.MFR.EQ.57.OR.MFR.EQ.59) THEN
  1345. NCOMP=NDEPL-IDECAP
  1346. ENDIF
  1347. IF (LDPGE) THEN
  1348. NCOMP=NDEPL-NDPGE
  1349. NBNNS=NBNN-1
  1350. ENDIF
  1351. IF (MFR.EQ.19.OR.MFR.EQ.21) NBNNS=NBNN/2
  1352. if (dcmat2) NCOMP = NDEPL/2
  1353. NOMID=MODEPL
  1354. SEGACT NOMID
  1355. NOMID=MOFORC
  1356. SEGACT NOMID
  1357. C
  1358. IF ((MFR.NE.61) .AND. (NBNNS*NCOMP .GT. NLIGRD)) THEN
  1359. C erreur dans les dimensions de DESCR
  1360. C le mode de calcul n'est pas correct
  1361. CALL ERREUR(717)
  1362. SEGSUP DESCR,MRIGID
  1363. C SEGDES MMODEL,MELEME
  1364. RETURN
  1365. ENDIF
  1366. C
  1367. IF(MFR.EQ.61)THEN
  1368. DO IE1=1,3
  1369. NOELEP(IE1)=1
  1370. NOELEP(IE1+3)=3
  1371. ENDDO
  1372. NOELEP(7)=2
  1373. NOELEP(8)=2
  1374. C
  1375. DO IE1=1,LRE
  1376. NOELED(IE1)=NOELEP(IE1)
  1377. ENDDO
  1378. C
  1379. NOMID=MODEPL
  1380. DO IE1=1,3
  1381. LISINC(IE1)=LESOBL(IE1)
  1382. LISINC(IE1+3)=LESOBL(IE1)
  1383. ENDDO
  1384. LISINC(7)=LESOBL(4)
  1385. LISINC(8)=LESOBL(5)
  1386. C
  1387. NOMID=MOFORC
  1388. DO IE1=1,3
  1389. LISDUA(IE1)=LESOBL(IE1)
  1390. LISDUA(IE1+3)=LESOBL(IE1)
  1391. ENDDO
  1392. LISDUA(7)=LESOBL(4)
  1393. LISDUA(8)=LESOBL(5)
  1394. ELSE
  1395. C
  1396. NFAC=(3*NBNN-IPORE)/2
  1397. DO 1004 INOEUD=1,NBNNS
  1398. IF ((MELE.GE.108.AND.MELE.LE.110.AND.INOEUD.GT.NFAC)
  1399. & .OR.(MELE.GE.185.AND.MELE.LE.187.AND.INOEUD.GT.NFAC)
  1400. & .OR.(MELE.GE.188.AND.MELE.LE.190.AND.INOEUD.GT.NFAC))
  1401. & GO TO 1004
  1402. DO 1005 ICOMP=1,NCOMP
  1403. NOMID=MODEPL
  1404. LISINC(IDDL)=LESOBL(ICOMP)
  1405. if (dcmat2) LISINC(IDDL)=LESOBL(IDDL)
  1406. NOMID=MOFORC
  1407. LISDUA(IDDL)=LESOBL(ICOMP)
  1408. if (dcmat2) LISDUA(IDDL)=LESOBL(IDDL)
  1409. NOELEP(IDDL)=INOEUD
  1410. NOELED(IDDL)=INOEUD
  1411. IDDL=IDDL+1
  1412. 1005 CONTINUE
  1413. 1004 CONTINUE
  1414. C
  1415. ENDIF
  1416. C
  1417. C CAS DE LA DEFORMATION PLANE GENERALISEE
  1418. C
  1419. IF (LDPGE) THEN
  1420. DO 1006 ICOMP=(NDPGE-1),0,-1
  1421. NOMID=MODEPL
  1422. LISINC(IDDL)=LESOBL(NDEPL-ICOMP)
  1423. NOMID=MOFORC
  1424. LISDUA(IDDL)=LESOBL(NFORC-ICOMP)
  1425. NOELEP(IDDL)=NBNN
  1426. NOELED(IDDL)=NBNN
  1427. IDDL=IDDL+1
  1428. 1006 CONTINUE
  1429. ENDIF
  1430. C
  1431. C CAS DES MILIEUX POREUX
  1432. C POUR LA PRESSION ON MET D'ABORD LES SOMMETS
  1433. C
  1434. IF (MFR.EQ.33) THEN
  1435. DO 1104 INOEUD=1,NBSOM(IELE)
  1436. NOMID=MODEPL
  1437. LISINC(IDDL)=LESOBL(NDEPL)
  1438. NOMID=MOFORC
  1439. LISDUA(IDDL)=LESOBL(NDEPL)
  1440. NOELEP(IDDL)=IBSOM(NSPOS(IELE)+INOEUD-1)
  1441. NOELED(IDDL)=IBSOM(NSPOS(IELE)+INOEUD-1)
  1442. IDDL=IDDL+1
  1443. 1104 CONTINUE
  1444. C
  1445. IF (MELE.GE.79.AND.MELE.LE.83) THEN
  1446. C
  1447. DO 1105 INOEUD=1,NBNN
  1448. DO 1115 INSOM=1,NBSOM(IELE)
  1449. IF(INOEUD.EQ.IBSOM(NSPOS(IELE)+INSOM-1)) GO TO 1105
  1450. 1115 CONTINUE
  1451. NOMID=MODEPL
  1452. LISINC(IDDL)=LESOBL(NDEPL)
  1453. NOMID=MOFORC
  1454. LISDUA(IDDL)=LESOBL(NDEPL)
  1455. NOELEP(IDDL)=INOEUD
  1456. NOELED(IDDL)=INOEUD
  1457. IDDL=IDDL+1
  1458. 1105 CONTINUE
  1459. C
  1460. ELSE IF (MELE.GE.108.AND.MELE.LE.110) THEN
  1461. C
  1462. DO 1109 INOEUD=NFAC+1,NBNN
  1463. NOMID=MODEPL
  1464. LISINC(IDDL)=LESOBL(NDEPL)
  1465. NOMID=MOFORC
  1466. LISDUA(IDDL)=LESOBL(NDEPL)
  1467. NOELEP(IDDL)=INOEUD
  1468. NOELED(IDDL)=INOEUD
  1469. IDDL=IDDL+1
  1470. 1109 CONTINUE
  1471. C
  1472. DO 1110 INOEUD=1,NFAC
  1473. DO 1111 INSOM=1,NBSOM(IELE)
  1474. IF(INOEUD.EQ.IBSOM(NSPOS(IELE)+INSOM-1)) GO TO 1110
  1475. 1111 CONTINUE
  1476. NOMID=MODEPL
  1477. LISINC(IDDL)=LESOBL(NDEPL)
  1478. NOMID=MOFORC
  1479. LISDUA(IDDL)=LESOBL(NDEPL)
  1480. NOELEP(IDDL)=INOEUD
  1481. NOELED(IDDL)=INOEUD
  1482. IDDL=IDDL+1
  1483. 1110 CONTINUE
  1484. C
  1485. ENDIF
  1486. C
  1487. ELSE IF(MFR.EQ.57.OR.MFR.EQ.59) THEN
  1488. C
  1489. DO 1304 IPR=1,IDECAP
  1490. NDECAP = NDEPL-IDECAP+IPR
  1491. C
  1492. DO 1204 INOEUD=1,NBSOM(IELE)
  1493. NOMID=MODEPL
  1494. LISINC(IDDL)=LESOBL(NDECAP)
  1495. NOMID=MOFORC
  1496. LISDUA(IDDL)=LESOBL(NDECAP)
  1497. NOELEP(IDDL)=IBSOM(NSPOS(IELE)+INOEUD-1)
  1498. NOELED(IDDL)=IBSOM(NSPOS(IELE)+INOEUD-1)
  1499. IDDL=IDDL+1
  1500. 1204 CONTINUE
  1501. C
  1502. IF (MELE.GE.173.AND.MELE.LE.182) THEN
  1503. C
  1504. DO 1205 INOEUD=1,NBNN
  1505. DO 1215 INSOM=1,NBSOM(IELE)
  1506. IF(INOEUD.EQ.IBSOM(NSPOS(IELE)+INSOM-1)) GO TO 1205
  1507. 1215 CONTINUE
  1508. NOMID=MODEPL
  1509. LISINC(IDDL)=LESOBL(NDECAP)
  1510. NOMID=MOFORC
  1511. LISDUA(IDDL)=LESOBL(NDECAP)
  1512. NOELEP(IDDL)=INOEUD
  1513. NOELED(IDDL)=INOEUD
  1514. IDDL=IDDL+1
  1515. 1205 CONTINUE
  1516. C
  1517. ELSE IF (MELE.GE.185.AND.MELE.LE.190) THEN
  1518. C
  1519. DO 1709 INOEUD=NFAC+1,NBNN
  1520. NOMID=MODEPL
  1521. LISINC(IDDL)=LESOBL(NDECAP)
  1522. NOMID=MOFORC
  1523. LISDUA(IDDL)=LESOBL(NDECAP)
  1524. NOELEP(IDDL)=INOEUD
  1525. NOELED(IDDL)=INOEUD
  1526. IDDL=IDDL+1
  1527. 1709 CONTINUE
  1528. C
  1529. DO 1710 INOEUD=1,NFAC
  1530. DO 1711 INSOM=1,NBSOM(IELE)
  1531. IF(INOEUD.EQ.IBSOM(NSPOS(IELE)+INSOM-1)) GO TO 1710
  1532. 1711 CONTINUE
  1533. NOMID=MODEPL
  1534. LISINC(IDDL)=LESOBL(NDECAP)
  1535. NOMID=MOFORC
  1536. LISDUA(IDDL)=LESOBL(NDECAP)
  1537. NOELEP(IDDL)=INOEUD
  1538. NOELED(IDDL)=INOEUD
  1539. IDDL=IDDL+1
  1540. 1710 CONTINUE
  1541. C
  1542. ENDIF
  1543. 1304 CONTINUE
  1544. ENDIF
  1545. C
  1546. C CAS DES ELEMENT RACCORD
  1547. C
  1548. IF (MFR.EQ.19.OR.MFR.EQ.21) THEN
  1549. CALL IDPRIM(IMODEL,MFR+1000,MODPL,NDEPL,NDUM)
  1550. CALL IDDUAL(IMODEL,MFR+1000,MOFRC,NFORC,NDUM)
  1551. NOMID=MODPL
  1552. SEGACT NOMID
  1553. NOMID=MOFRC
  1554. SEGACT NOMID
  1555. DO 1106 INOEUD=NBNNS+1,NBNN
  1556. DO 1107 ICOMP=1,NDEPL
  1557. NOMID=MODPL
  1558. LISINC(IDDL)=LESOBL(ICOMP)
  1559. NOMID=MOFRC
  1560. LISDUA(IDDL)=LESOBL(ICOMP)
  1561. NOELEP(IDDL)=INOEUD
  1562. NOELED(IDDL)=INOEUD
  1563. IDDL=IDDL+1
  1564. 1107 CONTINUE
  1565. 1106 CONTINUE
  1566. NOMID=MODPL
  1567. SEGsup NOMID
  1568. NOMID=MOFRC
  1569. SEGsup NOMID
  1570. ENDIF
  1571. C
  1572. NOMID=MODEPL
  1573. if(lsupdp)SEGsup NOMID
  1574. NOMID=MOFORC
  1575. if(lsupfo)SEGsup NOMID
  1576. SEGDES DESCR
  1577. C
  1578. C INITIALISATION DU SEGMENT XMATRI
  1579. C
  1580. NELRIG = NBELEM
  1581. NLIGRP=LRE
  1582. NLIGRD=LRE
  1583. SEGINI XMATRI
  1584. IPMATR=XMATRI
  1585. IF (LDPGE) THEN
  1586. IRIGEL(1,ISOU)=IPMADG
  1587. ELSE
  1588. IRIGEL(1,ISOU)=meleme
  1589. ENDIF
  1590. IRIGEL(2,ISOU)=0
  1591. IRIGEL(3,ISOU)=IPDSCR
  1592. IRIGEL(4,ISOU)=IPMATR
  1593. IRIGEL(5,ISOU)=NIFOUR
  1594. IRIGEL(6,ISOU)=0
  1595. IRIGEL(7,ISOU)=0
  1596. xmatri.symre=0
  1597. IF(MFR.EQ.57.OR.MFR.EQ.59) THEN
  1598. IRIGEL(7,ISOU)=2
  1599. ENDIF
  1600. COERIG(ISOU)=1.D0
  1601. C SEGDES XMATRI
  1602. C
  1603. C rendement anisotrope kich
  1604. if(ivacar.ne.0) then
  1605. mptval = ivacar
  1606. if(ival(/1).ge.ncar1+9) then
  1607. if (ival(ncar1+7).gt.0.or.ival(ncar1+8).gt.0.or.
  1608. & ival(ncar1+9).gt.0) then
  1609. irigel(7,isou)=2
  1610. xmatri.symre=2
  1611. endif
  1612. endif
  1613. endif
  1614. C
  1615. IF (LDPGE) THEN
  1616. C SEGDES MELEME
  1617. MELEME=IPMAIL
  1618. SEGACT MELEME
  1619. NBNN=NUM(/1)
  1620. ENDIF
  1621. C
  1622. descr= irigel(3,1)
  1623. segact descr
  1624. if (dcmate) goto 29
  1625. C
  1626. Cרררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררר
  1627. C P H A S E 3
  1628. C
  1629. C CALCUL DES RIGIDITES ELEMENTAIRES
  1630. C
  1631. Cרררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררר
  1632. C
  1633. C NUMERO DES ETIQUETTES :
  1634. C Les elements sont groupes comme suit :
  1635. C - massif,liquide 'surface libre' poreux ----------------------> r
  1636. C - coq3,dkt,coq4,coq8,coq2,dst --------------------------------> r
  1637. C - poutre,tuyau,linespring,tuyau fissure,barre,homogeneise,jot3> r
  1638. C - joi4,joi2,poutre de timoschenko,joi3
  1639. C
  1640. IF (MELE.LE.100)
  1641. C CABL SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5 QUA8 QUA9
  1642. & GOTO ( 99, 99, 99, 4, 99, 4, 99, 4, 99, 4, 99
  1643. C RAC2 RAC3 CUB8 CU20 PRI6 PR15 LIA3 LIA4 LIA6 LIA8 MULT
  1644. & , 12, 99, 4, 4, 4, 4, 12, 12, 99, 99, 99
  1645. C TET4 TE10 PYR5 PY13 COQ3 DKT POUT LISP FAC3 FAC4 FAC6
  1646. & , 4, 4, 4, 4, 27, 27, 29, 29, 99, 99, 99
  1647. C FAC8 LTR3 LQU4 LCU8 LPR6 LTE4 LPY5 COQ8 TUYA TUFI COQ2
  1648. & , 99, 4, 4, 4, 4, 4, 4, 27, 29, 29, 27
  1649. C POI1 BARR RACO LSU2 COQ4 LISM COF3 RES2 LSU3 LSU4 LICO
  1650. & , 29, 29, 12, 4, 27, 29, 99, 99, 4, 4, 12
  1651. C COQ6 CVS2 CVS3 CVT3 CVT6 CVQ4 CVQ8 THP5 TH13 THP6 TH15
  1652. & , 27, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  1653. C THC8 TH20 ICT3 ICQ4 ICT6 ICQ8 ICC8 ICT4 ICP6 IC20 IC10
  1654. & , 99, 99, 4, 4, 4, 4, 4, 4, 4, 4, 4
  1655. C IC15 TRIP QUAP CUBP TETP PRIP TIMO JOI2 JOI3 JOT3 JOI4
  1656. & , 4, 4, 4, 4, 4, 4, 29, 29, 29, 29, 29
  1657. C JOI6 JOI8 LISC TRIH DST LIC4 CERC TUYO LSE2 LITU HYT3
  1658. & , 99, 99, 99, 29, 27, 12, 29, 29, 29, 29, 99
  1659. C HYQ4
  1660. & , 99),MELE
  1661. IF (MELE.LE.200)
  1662. C HYT4 HYP6 HYC8 TRIS QUAS POIS FOR3 JOP3 JOP6 JOP8
  1663. & GOTO ( 99, 99, 99, 99, 99, 99, 99, 4, 4, 4
  1664. C POL3 POL4 POL5 POL6 POL7 POL8 POL9 PO10 PO11 PO12 PO13
  1665. & , 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4
  1666. C PO14 BAR3 BAEX LIA2 QUAH CUBH ROT3 SEF2 TRF3 QUF4 CUF8
  1667. & , 4, 29, 29, 29, 29, 29, 99, 99, 99, 99, 99
  1668. C PRF6 TEF4 PYF5 MSE3 MTR6 MQU9 MC27 MP18 MT10 MP14 SEF3
  1669. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  1670. C TRF7 QUF9 CF27 PF21 TF15 PF19 SEG6 TR21 QU36 C216 P126
  1671. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  1672. C TE56 PY91 TRH6 ???? ???? ???? ???? ???? ???? ???? ????
  1673. & , 99, 99, 29, 51, 51, 51, 51, 51, 51, 51, 51
  1674. C ???? ???? JCT3 JCI4 JGI2 JGT3 JGI4 ???? ???? ???? ????
  1675. & , 51, 51, 29, 29, 29, 29, 29, 4, 4, 4, 4
  1676. C ???? ???? ???? ???? ???? ???? Q4RI Q8RI ???? ???? ????
  1677. & , 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4
  1678. C ???? ???? ???? ???? ???? M1D2 M1D3 ???? ???? ???? ????
  1679. & , 4, 4, 4, 51, 51, 4, 4, 51, 51, 51, 51
  1680. C ???? ????
  1681. & , 51, 51),MELE-100
  1682. IF (MELE.LE.300)
  1683. C ???? ???? ???? ???? ???? ???? ???? ???? ????
  1684. & GOTO ( 51, 51, 51, 51, 51, 51, 51, 51, 51
  1685. C ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ????
  1686. & , 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51
  1687. C ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ????
  1688. & , 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51
  1689. C ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ????
  1690. & , 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51
  1691. C ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ????
  1692. & , 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51
  1693. C ???? ???? ???? ???? MACR ???? SHB8 ???? ???? XQ4R XC8R
  1694. & , 51, 51, 51, 51, 29, 51, 29, 51, 51, 63, 63
  1695. C JOI1 ZCO2 ZCO3 ZCO4 COS2 COA2
  1696. C cccccc
  1697. & , 29, 29, 29, 29, 51 , 51 , 29, 29, 4, 4),
  1698. & MELE-200
  1699. C cccccc
  1700. C
  1701. 51 CONTINUE
  1702. 99 CONTINUE
  1703. MOTERR(1:4)=NOMTP(MELE)
  1704. MOTERR(9:12)='RIGI1'
  1705. CALL ERREUR(86)
  1706. GOTO 9990
  1707. C_______________________________________________________________________
  1708. C
  1709. C massif, liquide, 'surface libre', poreux
  1710. C_______________________________________________________________________
  1711. C
  1712. 4 CONTINUE
  1713.  
  1714. IF (MFR .EQ. 71) THEN
  1715. CALL RIGELE (MATE,MELE,NBPGAU,NSTRS,LRE,IPMAIL,IPMINT,IVAMAT,
  1716. & NMATT, IPMATR)
  1717. ELSE IF (MFR .EQ. 73) THEN
  1718. CALL RIGDIF (MATE,MELE,NBPGAU,NSTRS,LRE,IPMAIL,IPMINT,IVAMAT,
  1719. & NMATT, IPMATR)
  1720. ELSE
  1721. CALL RIGI2 (MATE,MELE,IPMAIL,IPMINT,NBPGAU,LRE,NSTRS,IVAMAT,
  1722. & IVACAR,CMATE,MFR,NBGMAT,NELMAT,IMAT,LHOOK,NMATT,
  1723. & IPORE,NDDL,IPMATR,IIPDPG,ncar1,noer)
  1724. ENDIF
  1725. GOTO 9990
  1726. C_______________________________________________________________________
  1727. C
  1728. C ELTS DE RACCORD LIQUIDE SOLIDE RAC2 RACO LIA3 LIA4 LICO LIC4
  1729. C PAS DE RIGIDITE
  1730. C_______________________________________________________________________
  1731. C
  1732. 12 CONTINUE
  1733. C
  1734. C DO 3012 IB=1,NBELEM
  1735. C SEGINI XMATRI
  1736. C IMATTT(IB)=XMATRI
  1737. C SEGDES XMATRI
  1738. C 3012 CONTINUE
  1739. C SEGDES XMATRI
  1740. GOTO 9990
  1741. C_______________________________________________________________________
  1742. C
  1743. C coq2,coq3,coq4,coq6,coq8,dst,dkt
  1744. C_______________________________________________________________________
  1745. C
  1746. 27 CONTINUE
  1747. CALL RIGI3(MATE,MELE,IPMAIL,IPMINT,IPMIN1,NBPGAU,LRE,NSTRS,
  1748. & IVAMAT,IVACAR,CMATE,MFR,NBGMAT,NELMAT,IMAT,LHOOK,
  1749. & NMATT,LW,NPINT,IPMATR,IIPDPG)
  1750. GOTO 9990
  1751. C_______________________________________________________________________
  1752. C
  1753. C poutre,tuyau,linespring,tuyau fissure,barre,homogeneise,joints 2-3D
  1754. C poutre de Timoschenko,point,joi1,zco2,zco3,zco4
  1755. C_______________________________________________________________________
  1756. C
  1757. 29 CONTINUE
  1758. CALL RIGI4(MATE,MELE,IPMAIL,IPMINT,NBPGAU,LRE,NSTRS,
  1759. & IVAMAT,IVACAR,IVECT,CMATE,MFR,NBGMAT,NELMAT,IMAT,
  1760. & LHOOK,NMATT,(NCAR1 - 1),ISOUS,LW,IPORE,IPMATR,IIPDPG)
  1761. GOTO 9990
  1762.  
  1763. C
  1764. C_______________________________________________________________________
  1765. C
  1766. C Elements de type XFEM (MFR=63)
  1767. C_______________________________________________________________________
  1768. C Le sous programme RIGIXR gere les appels aux elements de type XFEM
  1769. C (imoxfem est le modele complet ou partitionne si necessaire)
  1770. C as 2009/11/30 : ajout de IMAT,NBGMAT,NELMAT en entrיe de RIGIXR
  1771. C Attention : ISOU peut etre modifie suite a appel a RIGIXR, ainsi que
  1772. C la dimension de MRIGID en parallele !
  1773. C
  1774. 63 CONTINUE
  1775. CALL RIGIXR (ISOU ,IPOI6,imoxfem,IPINF,
  1776. $ IVAMAT,IVACAR,NMATT,CMATE,NCAR1,NBGMAT,NELMAT,IMAT,IRETER)
  1777. IF (IRETER.NE.0) RETURN
  1778. GO TO 9991
  1779. C
  1780. Cרררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררר
  1781. C P H A S E 4
  1782. C
  1783. C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE IA
  1784. C
  1785. Cרררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררר
  1786. C
  1787. 9990 CONTINUE
  1788. if (noer.eq.195) return
  1789. if (ierr.ne.0) return
  1790. SEGDES XMATRI
  1791.  
  1792. 9991 CONTINUE
  1793. IF (IERR.NE.0) GOTO 518
  1794. 505 continue
  1795. C
  1796. 518 CONTINUE
  1797. IF(ISUP.EQ.1)THEN
  1798. C write(*,*) 'DTMVAL(IVACAR,3) ou IVACAR=',IVACAR
  1799. CALL DTMVAL(IVACAR,3)
  1800. ELSE
  1801. C write(*,*) 'DTMVAL(IVACAR,1) ou IVACAR=',IVACAR
  1802. CALL DTMVAL(IVACAR,1)
  1803. ENDIF
  1804. C
  1805. if (cmate.eq.'MODAL'.or.cmate.eq.'STATIQUE') goto 519
  1806. IF(ISUP.EQ.1.AND.IMAT.NE.2)THEN
  1807. CALL DTMVAL(IVAMAT,3)
  1808. C write(*,*) 'DTMVAL(IVACAR,3) ou IVACAR=',IVACAR
  1809. ELSE
  1810. C write(*,*) 'DTMVAL(IVACAR,1) ou IVACAR=',IVACAR
  1811. CALL DTMVAL(IVAMAT,1)
  1812. ENDIF
  1813. 519 continue
  1814. C
  1815. IF (MOCARA.NE.0)THEN
  1816. NOMID=MOCARA
  1817. SEGSUP NOMID
  1818. ENDIF
  1819.  
  1820. C
  1821. IF(MOMATR.NE.0)THEN
  1822. NOMID=MOMATR
  1823. if(lsupma)SEGSUP NOMID
  1824. ENDIF
  1825. C
  1826. C DANS LE CAS D'ERREUR
  1827. C
  1828. IF(IERR.NE.0) THEN
  1829. IF(DESCR.NE.0)SEGSUP DESCR
  1830. IF(xMATRI.NE.0)SEGSUP xMATRI
  1831. GOTO 888
  1832. ENDIF
  1833.  
  1834. 500 CONTINUE
  1835. C write(*,*) 'isous', isous, 'ISOU', isou, 'irigel(/2)', irigel(/2)
  1836. if (isou.NE.irigel(/2)) then
  1837. nrigel=isou
  1838. segadj,MRIGID
  1839. endif
  1840.  
  1841. Ctermes croises 'STATIQUE'/'MODAL'
  1842. nstat = kstat
  1843. nmoda = kmoda
  1844. segadj modsta
  1845. if (kstat.ne.0) then
  1846. if (nstat.gt.0.and.nstat+nmoda.gt.0) call ricroi(modsta, ir2,2)
  1847. if (nstat.gt.0) then
  1848. do kstat=1,nstat
  1849. mptval = ivstat(kstat)
  1850. segact mptval
  1851. IF(ISUP.EQ.1)THEN
  1852. CALL DTMVAL(mptval,3)
  1853. ELSE
  1854. CALL DTMVAL(mptval,1)
  1855. ENDIF
  1856. enddo
  1857. endif
  1858. if (nmoda.gt.0) then
  1859. do kmoda=1,nmoda
  1860. mptval = ivmoda(kmoda)
  1861. segact mptval
  1862. IF(ISUP.EQ.1)THEN
  1863. CALL DTMVAL(mptval,3)
  1864. ELSE
  1865. CALL DTMVAL(mptval,1)
  1866. ENDIF
  1867. enddo
  1868. endif
  1869. endif
  1870. if (nstat.gt.0.and.nstat+nmoda.gt.1) then
  1871. ir1 = mrigid
  1872. call fusrig(ir1,ir2,ir3)
  1873. if (ierr.ne.0) goto 888
  1874. mrigid = ir3
  1875. ipoi6 = mrigid
  1876. endif
  1877.  
  1878. 888 CONTINUE
  1879. MRIGID = IPOI6
  1880. IF (IERR.NE.0) THEN
  1881. SEGSUP,MRIGID
  1882. IPOI6 = 0
  1883. IRET = 0
  1884. ELSE
  1885. SEGDES,MRIGID
  1886. IRET = 1
  1887. ENDIF
  1888. segsup modsta
  1889. 889 CONTINUE
  1890. SEGSUP,MMODEL
  1891.  
  1892. END
  1893.  
  1894.  
  1895.  
  1896.  

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