Tיlיcharger rigi1.eso

Retour א la liste

Numיrotation des lignes :

  1. C RIGI1 SOURCE KICH 18/01/15 21:15:00 9696
  2.  
  3. SUBROUTINE RIGI1(MODORI,IPCHE1,IPCHE2,IMAT, IPOI6,IRET)
  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. ENDIF
  1103. C
  1104. C rendement kich 09/01
  1105. if (notype.le.0) then
  1106. nbtype = 0
  1107. segini notype
  1108. motype = notype
  1109. nbrobl = 0
  1110. nbrfac = 0
  1111. segini nomid
  1112. mocara = nomid
  1113. endif
  1114.  
  1115. ifac = nbrfac
  1116. NCAR1=NBROBL + NBRFAC + 1
  1117. NBRFAC= nbrfac + 10
  1118. segadj nomid
  1119. lesfac(ifac + 1) = 'REND'
  1120. lesfac(ifac + 2) = 'W1X '
  1121. lesfac(ifac + 3) = 'W1Y '
  1122. lesfac(ifac + 4) = 'W1Z '
  1123. lesfac(ifac + 5) = 'W2X '
  1124. lesfac(ifac + 6) = 'W2Y '
  1125. lesfac(ifac + 7) = 'W2Z '
  1126. lesfac(ifac + 8) = 'REN1'
  1127. lesfac(ifac + 9) = 'REN2'
  1128. lesfac(ifac + 10) = 'REN3'
  1129. NCARA=NBROBL
  1130. NCARF=NBRFAC
  1131. NCARR=NCARA+NCARF
  1132. nbtype = nbtype + 1
  1133. segadj notype
  1134. type(nbtype) = 'REAL*8'
  1135. C
  1136. IF (IPCHE1.NE.0.AND.MOCARA.NE.0) THEN
  1137. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,IVACAR)
  1138. SEGSUP NOTYPE
  1139. IF (IERR.NE.0) GOTO 9991
  1140. C
  1141. IF (ISUP.EQ.1) THEN
  1142. CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  1143. IF(IERR.NE.0)THEN
  1144. ISUP=0
  1145. GOTO 9991
  1146. ENDIF
  1147. ENDIF
  1148. ELSE
  1149. SEGSUP NOTYPE
  1150. ENDIF
  1151. C
  1152. C utiliser la densite pour ponderer par la prop de phase
  1153. C write (6,*) ' rigi1 conmod ',conmod
  1154. IF (conmod(17:24).NE.' ') THEN
  1155. C rechercher le melval
  1156. iptm = 0
  1157. MCHELM = IPCHE1
  1158. segact MCHELM
  1159. do ima = 1,imache(/1)
  1160. C write (6,*) ' rigi1 ima imache imamod ',ima,imache,imamod
  1161. if (imache(ima).eq.imamod) then
  1162. mchaml = ichaml(ima)
  1163. segact mchaml
  1164. do ic = 1,nomche(/2)
  1165. C write (6,*) ' rigi1 ima ic nomche ',ima,ic,nomche
  1166. if (nomche(ic)(1:4).eq.conmod(17:20)) then
  1167. iptm = ielval (ic)
  1168. segdes mchaml
  1169. segdes mchelm
  1170. goto 20
  1171. endif
  1172. enddo
  1173. segdes mchaml
  1174. endif
  1175. enddo
  1176. segdes mchelm
  1177. C avertissement
  1178. 20 if (iptm.eq.0)
  1179. & write(6,*) ' proportion phase non trouvee ',conmod(17:24)
  1180. C ponderation
  1181. if (iptm.gt.0) then
  1182. if(ivacar.ne.0) then
  1183. mptval = ivacar
  1184. segact mptval*mod
  1185. if (ival(ncar1).gt.0) then
  1186. melva1 = ival(ncar1)
  1187. melva2 = iptm
  1188. segact melva1,melva2
  1189. n1ptel = max(melva1.velche(/1),melva2.velche(/1))
  1190. n1el = max(melva1.velche(/2),melva2.velche(/2))
  1191. n2ptel = melva1.ielche(/1)
  1192. n2el = melva1.ielche(/2)
  1193. segini melval
  1194. do jptel = 1,n1ptel
  1195. do jel = 1,n1el
  1196. i1 = min(jptel,melva1.velche(/1))
  1197. j1 = min(jel,melva1.velche(/2))
  1198. i2 = min(jptel,melva2.velche(/1))
  1199. j2 = min(jel,melva2.velche(/2))
  1200. velche(jptel,jel) = melva1.velche(i1,j1)*melva2.velche(i2,j2)
  1201. enddo
  1202. enddo
  1203. ival(ncar1) = melval
  1204. segdes melva1,melva2
  1205. else if (ival(ncar1+7).gt.0.or.ival(ncar1+8).gt.0.or.
  1206. & ival(ncar1+9).gt.0) then
  1207. else
  1208. ival(ncar1) = iptm
  1209. tyval(ncar1) = 'REAL*8'
  1210. melval = iptm
  1211. segact melval
  1212. endif
  1213.  
  1214. endif
  1215. endif
  1216. ENDIF
  1217. C
  1218. C cas particuliers des XFEM
  1219. IF (MFR.EQ.63) GOTO 63
  1220.  
  1221. Cרררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררר
  1222. C P H A S E 2
  1223. C
  1224. C PREPARATION DES OBJETS RESULTATS
  1225. C
  1226. Cרררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררר
  1227. C
  1228. MELEME=IPMAIL
  1229. SEGACT MELEME
  1230. C
  1231. C MODIFICATION DU MELEME POUR LE REMPLISSAGE DU SEGMENT DESCRIPTEUR
  1232. C
  1233. IF (LDPGE) THEN
  1234. IPT3=meleme
  1235. SEGACT IPT3
  1236. NBELEM=NUM(/2)
  1237. NBNN=IPT3.NUM(/1)+1
  1238. NBREF=0
  1239. NBSOUS=0
  1240. SEGINI MELEME
  1241. DO 1007 I=1,NBELEM
  1242. DO 1008 J=1,NBNN-1
  1243. NUM(J,I)=IPT3.NUM(J,I)
  1244. 1008 CONTINUE
  1245. NUM(NBNN,I)=IIPDPG
  1246. 1007 CONTINUE
  1247. ITYPEL=28
  1248. ICOLOR=IPT3.ICOLOR
  1249. IPMADG=MELEME
  1250. SEGDES IPT3
  1251. ELSE
  1252. NBNN=NUM(/1)
  1253. NBELEM=NUM(/2)
  1254. ENDIF
  1255.  
  1256. C RECHERCHE DES NOMS D'INCONNUES ET DES DUAUX
  1257. C
  1258. NLIGRP= LRE
  1259. NLIGRD= LRE
  1260. SEGINI DESCR
  1261. IPDSCR=DESCR
  1262. if(lnomid(1).ne.0) then
  1263. nomid=lnomid(1)
  1264. segact nomid
  1265. modepl=nomid
  1266. ndepl=lesobl(/2)
  1267. ndum=lesfac(/2)
  1268. lsupdp=.false.
  1269. else
  1270. lsupdp=.true.
  1271. CALL IDPRIM(IMODEL,MFR,MODEPL,NDEPL,NDUM)
  1272. endif
  1273. if(lnomid(2).ne.0) then
  1274. nomid=lnomid(2)
  1275. segact nomid
  1276. moforc=nomid
  1277. nforc=lesobl(/2)
  1278. lsupfo=.false.
  1279. else
  1280. lsupfo=.true.
  1281. CALL IDDUAL(IMODEL,MFR,MOFORC,NFORC,NDUM)
  1282. endif
  1283. C
  1284. IF (NDEPL.EQ.0.OR.NFORC.EQ.0.OR.NDEPL.NE.NFORC) THEN
  1285. CALL ERREUR(5)
  1286. SEGSUP DESCR,MRIGID
  1287. SEGDES MMODEL,MELEME
  1288. RETURN
  1289. ENDIF
  1290. C
  1291. C REMPLISSAGE DU SEGMENT DESCRIPTEUR
  1292. C
  1293. IDDL=1
  1294. NCOMP=NDEPL
  1295. NBNNS=NBNN
  1296. IF (MFR.EQ.33.OR.MFR.EQ.57.OR.MFR.EQ.59) THEN
  1297. NCOMP=NDEPL-IDECAP
  1298. ENDIF
  1299. IF (LDPGE) THEN
  1300. NCOMP=NDEPL-NDPGE
  1301. NBNNS=NBNN-1
  1302. ENDIF
  1303. IF (MFR.EQ.19.OR.MFR.EQ.21) NBNNS=NBNN/2
  1304. if (dcmat2) NCOMP = NDEPL/2
  1305. NOMID=MODEPL
  1306. SEGACT NOMID
  1307. NOMID=MOFORC
  1308. SEGACT NOMID
  1309. C
  1310. IF ((MFR.NE.61) .AND. (NBNNS*NCOMP .GT. NLIGRD)) THEN
  1311. C erreur dans les dimensions de DESCR
  1312. C le mode de calcul n'est pas correct
  1313. write(6,*) ' plouf ici'
  1314. CALL ERREUR(717)
  1315. SEGSUP DESCR,MRIGID
  1316. SEGDES MMODEL,MELEME
  1317. RETURN
  1318. ENDIF
  1319. C
  1320. IF(MFR.EQ.61)THEN
  1321. DO IE1=1,3
  1322. NOELEP(IE1)=1
  1323. NOELEP(IE1+3)=3
  1324. ENDDO
  1325. NOELEP(7)=2
  1326. NOELEP(8)=2
  1327. C
  1328. DO IE1=1,LRE
  1329. NOELED(IE1)=NOELEP(IE1)
  1330. ENDDO
  1331. C
  1332. NOMID=MODEPL
  1333. DO IE1=1,3
  1334. LISINC(IE1)=LESOBL(IE1)
  1335. LISINC(IE1+3)=LESOBL(IE1)
  1336. ENDDO
  1337. LISINC(7)=LESOBL(4)
  1338. LISINC(8)=LESOBL(5)
  1339. C
  1340. NOMID=MOFORC
  1341. DO IE1=1,3
  1342. LISDUA(IE1)=LESOBL(IE1)
  1343. LISDUA(IE1+3)=LESOBL(IE1)
  1344. ENDDO
  1345. LISDUA(7)=LESOBL(4)
  1346. LISDUA(8)=LESOBL(5)
  1347. ELSE
  1348. C
  1349. NFAC=(3*NBNN-IPORE)/2
  1350. DO 1004 INOEUD=1,NBNNS
  1351. IF ((MELE.GE.108.AND.MELE.LE.110.AND.INOEUD.GT.NFAC)
  1352. & .OR.(MELE.GE.185.AND.MELE.LE.187.AND.INOEUD.GT.NFAC)
  1353. & .OR.(MELE.GE.188.AND.MELE.LE.190.AND.INOEUD.GT.NFAC))
  1354. & GO TO 1004
  1355. DO 1005 ICOMP=1,NCOMP
  1356. NOMID=MODEPL
  1357. LISINC(IDDL)=LESOBL(ICOMP)
  1358. if (dcmat2) LISINC(IDDL)=LESOBL(IDDL)
  1359. NOMID=MOFORC
  1360. LISDUA(IDDL)=LESOBL(ICOMP)
  1361. if (dcmat2) LISDUA(IDDL)=LESOBL(IDDL)
  1362. NOELEP(IDDL)=INOEUD
  1363. NOELED(IDDL)=INOEUD
  1364. IDDL=IDDL+1
  1365. 1005 CONTINUE
  1366. 1004 CONTINUE
  1367. C
  1368. ENDIF
  1369. C
  1370. C CAS DE LA DEFORMATION PLANE GENERALISEE
  1371. C
  1372. IF (LDPGE) THEN
  1373. DO 1006 ICOMP=(NDPGE-1),0,-1
  1374. NOMID=MODEPL
  1375. LISINC(IDDL)=LESOBL(NDEPL-ICOMP)
  1376. NOMID=MOFORC
  1377. LISDUA(IDDL)=LESOBL(NFORC-ICOMP)
  1378. NOELEP(IDDL)=NBNN
  1379. NOELED(IDDL)=NBNN
  1380. IDDL=IDDL+1
  1381. 1006 CONTINUE
  1382. ENDIF
  1383. C
  1384. C CAS DES MILIEUX POREUX
  1385. C POUR LA PRESSION ON MET D'ABORD LES SOMMETS
  1386. C
  1387. IF (MFR.EQ.33) THEN
  1388. DO 1104 INOEUD=1,NBSOM(IELE)
  1389. NOMID=MODEPL
  1390. LISINC(IDDL)=LESOBL(NDEPL)
  1391. NOMID=MOFORC
  1392. LISDUA(IDDL)=LESOBL(NDEPL)
  1393. NOELEP(IDDL)=IBSOM(NSPOS(IELE)+INOEUD-1)
  1394. NOELED(IDDL)=IBSOM(NSPOS(IELE)+INOEUD-1)
  1395. IDDL=IDDL+1
  1396. 1104 CONTINUE
  1397. C
  1398. IF (MELE.GE.79.AND.MELE.LE.83) THEN
  1399. C
  1400. DO 1105 INOEUD=1,NBNN
  1401. DO 1115 INSOM=1,NBSOM(IELE)
  1402. IF(INOEUD.EQ.IBSOM(NSPOS(IELE)+INSOM-1)) GO TO 1105
  1403. 1115 CONTINUE
  1404. NOMID=MODEPL
  1405. LISINC(IDDL)=LESOBL(NDEPL)
  1406. NOMID=MOFORC
  1407. LISDUA(IDDL)=LESOBL(NDEPL)
  1408. NOELEP(IDDL)=INOEUD
  1409. NOELED(IDDL)=INOEUD
  1410. IDDL=IDDL+1
  1411. 1105 CONTINUE
  1412. C
  1413. ELSE IF (MELE.GE.108.AND.MELE.LE.110) THEN
  1414. C
  1415. DO 1109 INOEUD=NFAC+1,NBNN
  1416. NOMID=MODEPL
  1417. LISINC(IDDL)=LESOBL(NDEPL)
  1418. NOMID=MOFORC
  1419. LISDUA(IDDL)=LESOBL(NDEPL)
  1420. NOELEP(IDDL)=INOEUD
  1421. NOELED(IDDL)=INOEUD
  1422. IDDL=IDDL+1
  1423. 1109 CONTINUE
  1424. C
  1425. DO 1110 INOEUD=1,NFAC
  1426. DO 1111 INSOM=1,NBSOM(IELE)
  1427. IF(INOEUD.EQ.IBSOM(NSPOS(IELE)+INSOM-1)) GO TO 1110
  1428. 1111 CONTINUE
  1429. NOMID=MODEPL
  1430. LISINC(IDDL)=LESOBL(NDEPL)
  1431. NOMID=MOFORC
  1432. LISDUA(IDDL)=LESOBL(NDEPL)
  1433. NOELEP(IDDL)=INOEUD
  1434. NOELED(IDDL)=INOEUD
  1435. IDDL=IDDL+1
  1436. 1110 CONTINUE
  1437. C
  1438. ENDIF
  1439. C
  1440. ELSE IF(MFR.EQ.57.OR.MFR.EQ.59) THEN
  1441. C
  1442. DO 1304 IPR=1,IDECAP
  1443. NDECAP = NDEPL-IDECAP+IPR
  1444. C
  1445. DO 1204 INOEUD=1,NBSOM(IELE)
  1446. NOMID=MODEPL
  1447. LISINC(IDDL)=LESOBL(NDECAP)
  1448. NOMID=MOFORC
  1449. LISDUA(IDDL)=LESOBL(NDECAP)
  1450. NOELEP(IDDL)=IBSOM(NSPOS(IELE)+INOEUD-1)
  1451. NOELED(IDDL)=IBSOM(NSPOS(IELE)+INOEUD-1)
  1452. IDDL=IDDL+1
  1453. 1204 CONTINUE
  1454. C
  1455. IF (MELE.GE.173.AND.MELE.LE.182) THEN
  1456. C
  1457. DO 1205 INOEUD=1,NBNN
  1458. DO 1215 INSOM=1,NBSOM(IELE)
  1459. IF(INOEUD.EQ.IBSOM(NSPOS(IELE)+INSOM-1)) GO TO 1205
  1460. 1215 CONTINUE
  1461. NOMID=MODEPL
  1462. LISINC(IDDL)=LESOBL(NDECAP)
  1463. NOMID=MOFORC
  1464. LISDUA(IDDL)=LESOBL(NDECAP)
  1465. NOELEP(IDDL)=INOEUD
  1466. NOELED(IDDL)=INOEUD
  1467. IDDL=IDDL+1
  1468. 1205 CONTINUE
  1469. C
  1470. ELSE IF (MELE.GE.185.AND.MELE.LE.190) THEN
  1471. C
  1472. DO 1709 INOEUD=NFAC+1,NBNN
  1473. NOMID=MODEPL
  1474. LISINC(IDDL)=LESOBL(NDECAP)
  1475. NOMID=MOFORC
  1476. LISDUA(IDDL)=LESOBL(NDECAP)
  1477. NOELEP(IDDL)=INOEUD
  1478. NOELED(IDDL)=INOEUD
  1479. IDDL=IDDL+1
  1480. 1709 CONTINUE
  1481. C
  1482. DO 1710 INOEUD=1,NFAC
  1483. DO 1711 INSOM=1,NBSOM(IELE)
  1484. IF(INOEUD.EQ.IBSOM(NSPOS(IELE)+INSOM-1)) GO TO 1710
  1485. 1711 CONTINUE
  1486. NOMID=MODEPL
  1487. LISINC(IDDL)=LESOBL(NDECAP)
  1488. NOMID=MOFORC
  1489. LISDUA(IDDL)=LESOBL(NDECAP)
  1490. NOELEP(IDDL)=INOEUD
  1491. NOELED(IDDL)=INOEUD
  1492. IDDL=IDDL+1
  1493. 1710 CONTINUE
  1494. C
  1495. ENDIF
  1496. 1304 CONTINUE
  1497. ENDIF
  1498. C
  1499. C CAS DES ELEMENT RACCORD
  1500. C
  1501. IF (MFR.EQ.19.OR.MFR.EQ.21) THEN
  1502. CALL IDPRIM(IMODEL,MFR+1000,MODPL,NDEPL,NDUM)
  1503. CALL IDDUAL(IMODEL,MFR+1000,MOFRC,NFORC,NDUM)
  1504. NOMID=MODPL
  1505. SEGACT NOMID
  1506. NOMID=MOFRC
  1507. SEGACT NOMID
  1508. DO 1106 INOEUD=NBNNS+1,NBNN
  1509. DO 1107 ICOMP=1,NDEPL
  1510. NOMID=MODPL
  1511. LISINC(IDDL)=LESOBL(ICOMP)
  1512. NOMID=MOFRC
  1513. LISDUA(IDDL)=LESOBL(ICOMP)
  1514. NOELEP(IDDL)=INOEUD
  1515. NOELED(IDDL)=INOEUD
  1516. IDDL=IDDL+1
  1517. 1107 CONTINUE
  1518. 1106 CONTINUE
  1519. NOMID=MODPL
  1520. SEGsup NOMID
  1521. NOMID=MOFRC
  1522. SEGsup NOMID
  1523. ENDIF
  1524. C
  1525. NOMID=MODEPL
  1526. if(lsupdp)SEGsup NOMID
  1527. NOMID=MOFORC
  1528. if(lsupfo)SEGsup NOMID
  1529. SEGDES DESCR
  1530. C
  1531. C INITIALISATION DU SEGMENT XMATRI
  1532. C
  1533. NELRIG = NBELEM
  1534. NLIGRP=LRE
  1535. NLIGRD=LRE
  1536. SEGINI XMATRI
  1537. IPMATR=XMATRI
  1538. IF (LDPGE) THEN
  1539. IRIGEL(1,ISOU)=IPMADG
  1540. ELSE
  1541. IRIGEL(1,ISOU)=meleme
  1542. ENDIF
  1543. IRIGEL(2,ISOU)=0
  1544. IRIGEL(3,ISOU)=IPDSCR
  1545. IRIGEL(4,ISOU)=IPMATR
  1546. IRIGEL(5,ISOU)=NIFOUR
  1547. IRIGEL(6,ISOU)=0
  1548. IRIGEL(7,ISOU)=0
  1549. xmatri.symre=0
  1550. IF(MFR.EQ.57.OR.MFR.EQ.59) THEN
  1551. IRIGEL(7,ISOU)=2
  1552. ENDIF
  1553. COERIG(ISOU)=1.D0
  1554. C SEGDES XMATRI
  1555. C
  1556. C rendement anisotrope kich
  1557. if(ivacar.ne.0) then
  1558. mptval = ivacar
  1559. if(ival(/1).ge.ncar1+9) then
  1560. if (ival(ncar1+7).gt.0.or.ival(ncar1+8).gt.0.or.
  1561. & ival(ncar1+9).gt.0) then
  1562. irigel(7,isou)=2
  1563. xmatri.symre=2
  1564. endif
  1565. endif
  1566. endif
  1567. C
  1568. IF (LDPGE) THEN
  1569. SEGDES MELEME
  1570. MELEME=IPMAIL
  1571. SEGACT MELEME
  1572. NBNN=NUM(/1)
  1573. ENDIF
  1574. C
  1575. descr= irigel(3,1)
  1576. segact descr
  1577. if (dcmate) goto 29
  1578. C
  1579. Cרררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררר
  1580. C P H A S E 3
  1581. C
  1582. C CALCUL DES RIGIDITES ELEMENTAIRES
  1583. C
  1584. Cרררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררר
  1585. C
  1586. C NUMERO DES ETIQUETTES :
  1587. C Les elements sont groupes comme suit :
  1588. C - massif,liquide 'surface libre' poreux ----------------------> r
  1589. C - coq3,dkt,coq4,coq8,coq2,dst --------------------------------> r
  1590. C - poutre,tuyau,linespring,tuyau fissure,barre,homogeneise,jot3> r
  1591. C - joi4,joi2,poutre de timoschenko,joi3
  1592. C
  1593. IF (MELE.LE.100)
  1594. C CABL SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5 QUA8 QUA9
  1595. & GOTO ( 99, 99, 99, 4, 99, 4, 99, 4, 99, 4, 99
  1596. C RAC2 RAC3 CUB8 CU20 PRI6 PR15 LIA3 LIA4 LIA6 LIA8 MULT
  1597. & , 12, 99, 4, 4, 4, 4, 12, 12, 99, 99, 99
  1598. C TET4 TE10 PYR5 PY13 COQ3 DKT POUT LISP FAC3 FAC4 FAC6
  1599. & , 4, 4, 4, 4, 27, 27, 29, 29, 99, 99, 99
  1600. C FAC8 LTR3 LQU4 LCU8 LPR6 LTE4 LPY5 COQ8 TUYA TUFI COQ2
  1601. & , 99, 4, 4, 4, 4, 4, 4, 27, 29, 29, 27
  1602. C POI1 BARR RACO LSU2 COQ4 LISM COF3 RES2 LSU3 LSU4 LICO
  1603. & , 29, 29, 12, 4, 27, 29, 99, 99, 4, 4, 12
  1604. C COQ6 CVS2 CVS3 CVT3 CVT6 CVQ4 CVQ8 THP5 TH13 THP6 TH15
  1605. & , 27, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  1606. C THC8 TH20 ICT3 ICQ4 ICT6 ICQ8 ICC8 ICT4 ICP6 IC20 IC10
  1607. & , 99, 99, 4, 4, 4, 4, 4, 4, 4, 4, 4
  1608. C IC15 TRIP QUAP CUBP TETP PRIP TIMO JOI2 JOI3 JOT3 JOI4
  1609. & , 4, 4, 4, 4, 4, 4, 29, 29, 29, 29, 29
  1610. C JOI6 JOI8 LISC TRIH DST LIC4 CERC TUYO LSE2 LITU HYT3
  1611. & , 99, 99, 99, 29, 27, 12, 29, 29, 29, 29, 99
  1612. C HYQ4
  1613. & , 99),MELE
  1614. IF (MELE.LE.200)
  1615. C HYT4 HYP6 HYC8 TRIS QUAS POIS FOR3 JOP3 JOP6 JOP8
  1616. & GOTO ( 99, 99, 99, 99, 99, 99, 99, 4, 4, 4
  1617. C POL3 POL4 POL5 POL6 POL7 POL8 POL9 PO10 PO11 PO12 PO13
  1618. & , 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4
  1619. C PO14 BAR3 BAEX LIA2 QUAH CUBH ROT3 SEF2 TRF3 QUF4 CUF8
  1620. & , 4, 29, 29, 29, 29, 29, 99, 99, 99, 99, 99
  1621. C PRF6 TEF4 PYF5 MSE3 MTR6 MQU9 MC27 MP18 MT10 MP14 SEF3
  1622. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  1623. C TRF7 QUF9 CF27 PF21 TF15 PF19 SEG6 TR21 QU36 C216 P126
  1624. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  1625. C TE56 PY91 TRH6 ???? ???? ???? ???? ???? ???? ???? ????
  1626. & , 99, 99, 29, 51, 51, 51, 51, 51, 51, 51, 51
  1627. C ???? ???? JCT3 JCI4 JGI2 JGT3 JGI4 ???? ???? ???? ????
  1628. & , 51, 51, 29, 29, 29, 29, 29, 4, 4, 4, 4
  1629. C ???? ???? ???? ???? ???? ???? Q4RI Q8RI ???? ???? ????
  1630. & , 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4
  1631. C ???? ???? ???? ???? ???? M1D2 M1D3 ???? ???? ???? ????
  1632. & , 4, 4, 4, 51, 51, 4, 4, 51, 51, 51, 51
  1633. C ???? ????
  1634. & , 51, 51),MELE-100
  1635. IF (MELE.LE.300)
  1636. C ???? ???? ???? ???? ???? ???? ???? ???? ????
  1637. & GOTO ( 51, 51, 51, 51, 51, 51, 51, 51, 51
  1638. C ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ????
  1639. & , 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51
  1640. C ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ????
  1641. & , 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51
  1642. C ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ????
  1643. & , 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51
  1644. C ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ????
  1645. & , 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51
  1646. C ???? ???? ???? ???? MACR ???? SHB8 ???? ???? XQ4R XC8R
  1647. & , 51, 51, 51, 51, 29, 51, 29, 51, 51, 63, 63
  1648. C JOI1 ZCO2 ZCO3 ZCO4 COS2 COA2
  1649. C cccccc
  1650. & , 29, 29, 29, 29, 51 , 51 , 29, 29, 4, 4),
  1651. & MELE-200
  1652. C cccccc
  1653. C
  1654. 51 CONTINUE
  1655. 99 CONTINUE
  1656. MOTERR(1:4)=NOMTP(MELE)
  1657. MOTERR(9:12)='RIGI1'
  1658. CALL ERREUR(86)
  1659. GOTO 9990
  1660. C_______________________________________________________________________
  1661. C
  1662. C massif, liquide, 'surface libre', poreux
  1663. C_______________________________________________________________________
  1664. C
  1665. 4 CONTINUE
  1666.  
  1667. IF (MFR .EQ. 71) THEN
  1668. CALL RIGELE (MATE,MELE,NBPGAU,NSTRS,LRE,IPMAIL,IPMINT,IVAMAT,
  1669. & NMATT, IPMATR)
  1670. ELSE IF (MFR .EQ. 73) THEN
  1671. CALL RIGDIF (MATE,MELE,NBPGAU,NSTRS,LRE,IPMAIL,IPMINT,IVAMAT,
  1672. & NMATT, IPMATR)
  1673. ELSE
  1674. CALL RIGI2 (MATE,MELE,IPMAIL,IPMINT,NBPGAU,LRE,NSTRS,IVAMAT,
  1675. & IVACAR,CMATE,MFR,NBGMAT,NELMAT,IMAT,LHOOK,NMATT,
  1676. & IPORE,NDDL,IPMATR,IIPDPG,ncar1)
  1677. ENDIF
  1678. GOTO 9990
  1679. C_______________________________________________________________________
  1680. C
  1681. C ELTS DE RACCORD LIQUIDE SOLIDE RAC2 RACO LIA3 LIA4 LICO LIC4
  1682. C PAS DE RIGIDITE
  1683. C_______________________________________________________________________
  1684. C
  1685. 12 CONTINUE
  1686. C
  1687. C DO 3012 IB=1,NBELEM
  1688. C SEGINI XMATRI
  1689. C IMATTT(IB)=XMATRI
  1690. C SEGDES XMATRI
  1691. C 3012 CONTINUE
  1692. C SEGDES XMATRI
  1693. GOTO 9990
  1694. C_______________________________________________________________________
  1695. C
  1696. C coq2,coq3,coq4,coq6,coq8,dst,dkt
  1697. C_______________________________________________________________________
  1698. C
  1699. 27 CONTINUE
  1700. CALL RIGI3(MATE,MELE,IPMAIL,IPMINT,IPMIN1,NBPGAU,LRE,NSTRS,
  1701. & IVAMAT,IVACAR,CMATE,MFR,NBGMAT,NELMAT,IMAT,LHOOK,
  1702. & NMATT,LW,NPINT,IPMATR,IIPDPG)
  1703. GOTO 9990
  1704. C_______________________________________________________________________
  1705. C
  1706. C poutre,tuyau,linespring,tuyau fissure,barre,homogeneise,joints 2-3D
  1707. C poutre de Timoschenko,point,joi1,zco2,zco3,zco4
  1708. C_______________________________________________________________________
  1709. C
  1710. 29 CONTINUE
  1711. CALL RIGI4(MATE,MELE,IPMAIL,IPMINT,NBPGAU,LRE,NSTRS,
  1712. & IVAMAT,IVACAR,IVECT,CMATE,MFR,NBGMAT,NELMAT,IMAT,
  1713. & LHOOK,NMATT,(NCAR1 - 1),ISOUS,LW,IPORE,IPMATR,IIPDPG)
  1714. GOTO 9990
  1715.  
  1716. C
  1717. C_______________________________________________________________________
  1718. C
  1719. C Elements de type XFEM (MFR=63)
  1720. C_______________________________________________________________________
  1721. C Le sous programme RIGIXR gere les appels aux elements de type XFEM
  1722. C (imoxfem est le modele complet ou partitionne si necessaire)
  1723. C as 2009/11/30 : ajout de IMAT,NBGMAT,NELMAT en entrיe de RIGIXR
  1724. C Attention : ISOU peut etre modifie suite a appel a RIGIXR, ainsi que
  1725. C la dimension de MRIGID en parallele !
  1726. C
  1727. 63 CONTINUE
  1728. CALL RIGIXR (ISOU ,IPOI6,imoxfem,IPINF,
  1729. $ IVAMAT,IVACAR,NMATT,CMATE,NCAR1,NBGMAT,NELMAT,IMAT,IRETER)
  1730. IF (IRETER.NE.0) RETURN
  1731. GO TO 9991
  1732. C
  1733. Cרררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררר
  1734. C P H A S E 4
  1735. C
  1736. C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE IA
  1737. C
  1738. Cרררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררר
  1739. C
  1740. 9990 CONTINUE
  1741. if (ierr.ne.0) return
  1742. SEGDES XMATRI
  1743. SEGDES MELEME
  1744.  
  1745. 9991 CONTINUE
  1746. IF (IERR.NE.0) GOTO 518
  1747. 505 continue
  1748. C
  1749. 518 CONTINUE
  1750. IF(ISUP.EQ.1)THEN
  1751. C write(*,*) 'DTMVAL(IVACAR,3) ou IVACAR=',IVACAR
  1752. CALL DTMVAL(IVACAR,3)
  1753. ELSE
  1754. C write(*,*) 'DTMVAL(IVACAR,1) ou IVACAR=',IVACAR
  1755. CALL DTMVAL(IVACAR,1)
  1756. ENDIF
  1757. C
  1758. if (cmate.eq.'MODAL'.or.cmate.eq.'STATIQUE') goto 519
  1759. IF(ISUP.EQ.1.AND.IMAT.NE.2)THEN
  1760. CALL DTMVAL(IVAMAT,3)
  1761. C write(*,*) 'DTMVAL(IVACAR,3) ou IVACAR=',IVACAR
  1762. ELSE
  1763. C write(*,*) 'DTMVAL(IVACAR,1) ou IVACAR=',IVACAR
  1764. CALL DTMVAL(IVAMAT,1)
  1765. ENDIF
  1766. 519 continue
  1767. C
  1768. IF (MOCARA.NE.0)THEN
  1769. NOMID=MOCARA
  1770. SEGSUP NOMID
  1771. ENDIF
  1772.  
  1773. C
  1774. IF(MOMATR.NE.0)THEN
  1775. NOMID=MOMATR
  1776. if(lsupma)SEGSUP NOMID
  1777. ENDIF
  1778. C
  1779.  
  1780. IF (IPMINT.NE.0) SEGDES,MINTE
  1781.  
  1782. C
  1783. C DANS LE CAS D'ERREUR
  1784. C
  1785. IF(IERR.NE.0) THEN
  1786. IF(DESCR.NE.0)SEGSUP DESCR
  1787. IF(xMATRI.NE.0)SEGSUP xMATRI
  1788. GOTO 888
  1789. ENDIF
  1790.  
  1791. 500 CONTINUE
  1792. C write(*,*) 'isous', isous, 'ISOU', isou, 'irigel(/2)', irigel(/2)
  1793. if (isou.NE.irigel(/2)) then
  1794. nrigel=isou
  1795. segadj,MRIGID
  1796. endif
  1797.  
  1798. Ctermes croises 'STATIQUE'/'MODAL'
  1799. nstat = kstat
  1800. nmoda = kmoda
  1801. segadj modsta
  1802. if (kstat.ne.0) then
  1803. if (nstat.gt.0.and.nstat+nmoda.gt.0) call ricroi(modsta, ir2,2)
  1804. if (nstat.gt.0) then
  1805. do kstat=1,nstat
  1806. mptval = ivstat(kstat)
  1807. segact mptval
  1808. IF(ISUP.EQ.1)THEN
  1809. CALL DTMVAL(mptval,3)
  1810. ELSE
  1811. CALL DTMVAL(mptval,1)
  1812. ENDIF
  1813. enddo
  1814. endif
  1815. if (nmoda.gt.0) then
  1816. do kmoda=1,nmoda
  1817. mptval = ivmoda(kmoda)
  1818. segact mptval
  1819. IF(ISUP.EQ.1)THEN
  1820. CALL DTMVAL(mptval,3)
  1821. ELSE
  1822. CALL DTMVAL(mptval,1)
  1823. ENDIF
  1824. enddo
  1825. endif
  1826. endif
  1827. if (nstat.gt.0.and.nstat+nmoda.gt.1) then
  1828. ir1 = mrigid
  1829. call fusrig(ir1,ir2,ir3)
  1830. if (ierr.ne.0) goto 888
  1831. mrigid = ir3
  1832. ipoi6 = mrigid
  1833. endif
  1834.  
  1835. 888 CONTINUE
  1836. IF (IPCHE1.NE.0) THEN
  1837. MCHELM=IPCHE1
  1838. SEGDES MCHELM
  1839. ENDIF
  1840. IF (IPCHOO.NE.0) THEN
  1841. MCHELM=IPCHOO
  1842. SEGDES MCHELM
  1843. ENDIF
  1844. MRIGID = IPOI6
  1845. IF (IERR.NE.0) THEN
  1846. SEGSUP,MRIGID
  1847. IPOI6 = 0
  1848. IRET = 0
  1849. ELSE
  1850. SEGDES,MRIGID
  1851. IRET = 1
  1852. ENDIF
  1853. segsup modsta
  1854. 889 CONTINUE
  1855. MMODEL = IPMODL
  1856. DO i = 1, NSOUS
  1857. IMODEL = KMODEL(i)
  1858. SEGDES,IMODEL
  1859. ENDDO
  1860. SEGSUP,MMODEL
  1861.  
  1862. RETURN
  1863. END
  1864.  
  1865.  
  1866.  
  1867.  
  1868.  
  1869.  
  1870.  
  1871.  

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