Tיlיcharger rigi1.eso

Retour א la liste

Numיrotation des lignes :

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

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