Tיlיcharger rigi1.eso

Retour א la liste

Numיrotation des lignes :

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

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