Tיlיcharger rigi1.eso

Retour א la liste

Numיrotation des lignes :

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

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