Télécharger epsi1.eso

Retour à la liste

Numérotation des lignes :

  1. C EPSI1 SOURCE GF238795 18/02/01 21:15:23 9724
  2. SUBROUTINE EPSI1(IREPS3,MODORI,IPCHP1,IPCHA1,IPCHA2,
  3. 1 IMAT,IPEPSI,IRET,ipchp2,noer,kerr)
  4. C_______________________________________________________________________
  5. C
  6. C OPERATEUR DEFORMATIONS APPELE PAR EPSI
  7. C
  8. C ENTREES :
  9. C _________
  10. C
  11. C MODORI POINTEUR SUR UN MMODEL
  12. C IPCHP1 POINTEUR SUR UN CHAMPOINT DEPLACEMENT
  13. C IPCHA1 POINTEUR SUR UN MCHAML DE CARACTERISTIQUE (FACULTATIF)
  14. C IPCHA2 POINTEUR SUR UN MCHAML DE HOOKE (FACULTATIF)
  15. C IMAT Flag de HOOKE (2 si oui, 1 sinon)
  16. C
  17. C SORTIES :
  18. C _________
  19. C
  20. C IPEPSI POINTEUR SUR UN MCHAML DE DEFORMATION
  21. C IRET 1 OU 0 SUIVANT SUCCES OU PAS
  22. C
  23. C PASSAGE AUX NOUVEAUX CHAMELEMS PAR JM.CAMPENON LE 01.08.90
  24. C
  25. C-----------------------------------------------------------------------
  26. IMPLICIT INTEGER(I-N)
  27. IMPLICIT REAL*8(A-H,O-Z)
  28.  
  29. -INC CCOPTIO
  30. -INC CCREEL
  31. -INC CCHAMP
  32. -INC SMCHAML
  33. -INC SMCHPOI
  34. -INC SMELEME
  35. -INC SMCOORD
  36. -INC SMMODEL
  37. -INC SMINTE
  38. -INC SMLREEL
  39.  
  40. SEGMENT NOTYPE
  41. CHARACTER*16 TYPE(NBTYPE)
  42. ENDSEGMENT
  43. C
  44. SEGMENT MPTVAL
  45. INTEGER IPOS(NS),NSOF(NS)
  46. INTEGER IVAL(NCOSOU)
  47. CHARACTER*16 TYVAL(NCOSOU)
  48. ENDSEGMENT
  49.  
  50. CHARACTER*8 CMATE
  51. CHARACTER*(NCONCH) CONM
  52. PARAMETER (NINF=3)
  53. INTEGER INFOS(NINF)
  54. INTEGER ISUP1
  55. LOGICAL LDPGE,lsupde,lsupdp,lsupma,dcmate
  56. C
  57. ISUP1=0
  58. IRET = 0
  59. IPEPSI = 0
  60. kerr = 0
  61.  
  62. NHRM=NIFOUR
  63. C
  64. C ON VERIFIE QUE LE MCHAML DE CARACTERISTIQUE EST SUR SON SUPPORT
  65. C
  66. IF (IPCHA1.NE.0) THEN
  67. CALL QUESUP (MODORI,IPCHA1,5,0,ISUP1,IRET0)
  68. IF (ISUP1.GT.1) RETURN
  69. ELSE
  70. C SI massif jaumann et truesdel ==> manque un argument
  71. C IF() THEN
  72. C CALL ERREUR(404)
  73. C RETURN
  74. C ENDIF
  75. ENDIF
  76. C
  77. C ON VERIFIE QUE LE MCHAML DE HOOKE EST SUR SON SUPPORT
  78. C
  79. IF (IPCHA2.NE.0) THEN
  80. CALL QUESUP (MODORI,IPCHA2,5,1,ISUP2,IRET0)
  81. IF (ISUP2.NE.0) RETURN
  82. ENDIF
  83. C_______________________________________________________________________
  84. C
  85. C ON CONVERTIT LE CHAMP POINT EN CHAMP PAR ELEMENT idem pour le 2eme
  86. C_______________________________________________________________________
  87. CALL CHAME1 (0,MODORI,IPCHP1,' ',IPCH1,1)
  88. IF (IERR.NE.0) RETURN
  89. ipch2=0
  90. IF( ipchp2.ne.0)call CHAME1 (0,MODORI,IPCHP2,' ',IPCH2,1)
  91. C
  92. C ACTIVATION DU MODELE
  93. C
  94. C MODORI = Modele initial complet
  95. C IPMODL = Modele "deroule" (uniquement "MECANIQUE", "LIQUIDE" ou "POREUX")
  96. CALL PIMODL(MODORI,IPMODL)
  97. IF (IPMODL.EQ.0) RETURN
  98. C IPMODL est ACTIF en retour (nouveau pointeur pouvant etre detruit)
  99. MMODEL=IPMODL
  100. NSOUS = KMODEL(/1)
  101. C
  102. C CREATION DU MCHELM
  103. C
  104. KNB22=0
  105. DO IJKL=1,NSOUS
  106. IMODEL=KMODEL(IJKL)
  107. SEGACT IMODEL
  108. IF (NEFMOD.EQ.22.OR.NEFMOD.EQ.259) KNB22=KNB22+1
  109. END DO
  110. N1=NSOUS-KNB22
  111. L1=12
  112. N3=6
  113. SEGINI MCHELM
  114. TITCHE='DEFORMATIONS'
  115. IFOCHE=IFOUR
  116.  
  117. C_______________________________________________________________________
  118. C
  119. C DEBUT DE LA BOUCLE SUR LES DIFFERENTES SOUS ZONES
  120. C_______________________________________________________________________
  121. C
  122. ISOUS=0
  123. DO 500 KISOUS=1,NSOUS
  124. C
  125. IMODEL=KMODEL(KISOUS)
  126. C* SEGACT IMODEL
  127. MELE=NEFMOD
  128. IF (MELE.EQ.22.OR.MELE.EQ.259) GOTO 9992
  129. C
  130. ISOUS=ISOUS+1
  131. C
  132. C INITIALISATION
  133. C
  134. IVAMAT=0
  135. IVACAR=0
  136. IVADEP=0
  137. IVAEPS=0
  138. IPMINT=0
  139. MOMATR=0
  140. MOCARA=0
  141. MOEPSI=0
  142. MODEPL=0
  143. lsupma=.true.
  144. lsupde=.true.
  145. lsupdp=.true.
  146. dcmate = .false.
  147. C
  148. C ON RECUPERE L INFORMATION GENERALE
  149. C
  150. IPMAIL=IMAMOD
  151. CONM =CONMOD
  152. IDERI=ideriv
  153. if( ireps3.eq.4) then
  154. ideri=1
  155. ireps2=0
  156. else
  157. if(ideriv.eq.2) then
  158. ireps2=1
  159. else
  160. ireps2=0
  161. endif
  162. endif
  163. C
  164. C CREATION DE TABLEAU INFOS
  165. C
  166. CALL IDENT(IPMAIL,CONM,IPCH1,IPCHA1,INFOS,IRTD)
  167. IF (IRTD.EQ.0) GOTO 9992
  168. C
  169. C TRAITEMENT DU MODELE
  170. C
  171. MELEME=IPMAIL
  172. IMACHE(ISOUS)=IPMAIL
  173. CONCHE(ISOUS)=CONMOD
  174. C
  175. C NATURE DU MATERIAU
  176. C
  177. CMATE = CMATEE
  178. MATE = IMATEE
  179. INAT = INATUU
  180. C IF (CMATE.EQ.' ')THEN
  181. C CALL ERREUR(251)
  182. C GOTO 9992
  183. C ENDIF
  184. do im = 1,matmod(/2)
  185. if (matmod(im).eq.'IMPEDANCE') dcmate =.true.
  186. enddo
  187. C_______________________________________________________________________
  188. C
  189. C INFORMATION SUR L ELEMENT FINI
  190. C_______________________________________________________________________
  191. C
  192. IF (INFMOD(/1).NE.0) THEN
  193. NPINT=INFMOD(1)
  194. ELSE
  195. NPINT=0
  196. ENDIF
  197. MFR =INFELE(13)
  198. IELE =INFELE(14)
  199. IPORE =INFELE(8)
  200. C NBG =INFELE(6)
  201. NBGS =INFELE(4)
  202. NSTRS =INFELE(16)
  203. LRE =INFELE(9)
  204. LW =INFELE(7)
  205. LHOOK =INFELE(10)
  206. C LHOO2 =LHOOK*LHOOK
  207. C NDDL =INFELE(15)
  208. C MINTE =INFELE(11)
  209. MINTE=infmod(7)
  210. IPMINT=MINTE
  211. IPMIN1=INFMOD(8)
  212. C
  213. C ACTIVATION DE MELEME
  214. C
  215. SEGACT MELEME
  216. if (dcmate) then
  217. if (itypel.eq.1) mele = 45
  218. if (itypel.eq.2) mele = 2
  219. endif
  220. NBNN =NUM(/1)
  221. C NBELEM=NUM(/2)
  222. IPPORE=0
  223. IF(MFR.EQ.33.OR.MFR.EQ.57.OR.MFR.EQ.59) IPPORE=NBNN
  224. If((mfr.ne.1.and.ippore.ne.1).and.(ideri.eQ.3.or.ideri.eq.4))then
  225. call erreur (1013)
  226. return
  227. endif
  228. C
  229. C EXTRACTION DES DEPLACEMENTS DU NOEUD SUPPORT DE LA
  230. C DEFORMATION PLANE GENERALISEE (MECANIQUE) SI BESOIN
  231. C
  232. CALL INFDPG(MFR,IFOUR, LDPGE, ndpge)
  233. IF (LDPGE) THEN
  234. IIPDPG = imodel.IPDPGE
  235. IIPDPG = IPTPOI(IIPDPG)
  236. CALL DEPDPG(IPCHP1,UZDPG,RXDPG,RYDPG,IIPDPG)
  237. IF (IERR.NE.0) GOTO 9992
  238. ELSE
  239. IIPDPG = 0
  240. UZDPG=XZero
  241. RXDPG=XZero
  242. RYDPG=XZero
  243. ENDIF
  244. C
  245. INFCHE(ISOUS,1)=0
  246. INFCHE(ISOUS,2)=0
  247. INFCHE(ISOUS,3)=NHRM
  248. INFCHE(ISOUS,4)=IPMINT
  249. INFCHE(ISOUS,5)=0
  250. INFCHE(ISOUS,6)=5
  251. C
  252. C INITIALISATION DE MINTE
  253. C
  254. SEGACT MINTE
  255. NBPGAU=POIGAU(/1)
  256. C_______________________________________________________________________
  257. C
  258. C RECHERCHE DES NOMS COMPOSANTES
  259. C_______________________________________________________________________
  260. C
  261. if(lnomid(5).ne.0) then
  262. lsupde=.false.
  263. nomid=lnomid(5)
  264. segact nomid
  265. ndef=lesobl(/2)
  266. ndefac=lesfac(/2)
  267. moepsi=nomid
  268. else
  269. CALL IDDEFO(IMODEL,IFOUR,MOEPSI,NDEF,NDEFAC)
  270. endif
  271. C
  272. if(lnomid(1).ne.0) then
  273. lsupdp=.false.
  274. nomid=lnomid(1)
  275. segact nomid
  276. modepl=nomid
  277. ndep=lesobl(/2)
  278. nfac=lesfac(/2)
  279. else
  280. CALL IDPRIM(IMODEL,MFR,MODEPL,NDEP,NFAC)
  281. endif
  282. C
  283. C_______________________________________________________________________
  284. C
  285. C VERIFICATION DE LEUR PRESENCE
  286. C_______________________________________________________________________
  287. C
  288. NBTYPE=1
  289. SEGINI NOTYPE
  290. TYPE(1)='REAL*8'
  291. MOTYPE=NOTYPE
  292. CALL KOMCHA(IPCH1,IPMAIL,CONM,MODEPL,MOTYPE,1,INFOS,3,IVADEP)
  293. SEGSUP NOTYPE
  294. NOMID=MODEPL
  295. SEGDES,NOMID
  296. IF (IERR.NE.0) GOTO 9993
  297. IVADE2=0
  298. if( ipch2.ne.0) then
  299. C traitement du 2eme champs par point
  300. NBTYPE=1
  301. SEGINI NOTYPE
  302. TYPE(1)='REAL*8'
  303. MOTYPE=NOTYPE
  304. CALL KOMCHA(IPCH2,IPMAIL,CONM,MODEPL,MOTYPE,1,INFOS,3,IVADE2)
  305. SEGSUP NOTYPE
  306. IF (IERR.NE.0) GOTO 9993
  307. ENDIF
  308. C
  309. C RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER
  310. C
  311. N1PTEL=0
  312. N1EL=0
  313. MPTVAL=IVADEP
  314. DO 110 I0=1,NDEP
  315. MELVAL=IVAL(I0)
  316. N1PTEL=MAX(N1PTEL,VELCHE(/1))
  317. N1EL =MAX(N1EL,VELCHE(/2))
  318. 110 CONTINUE
  319. IF (N1PTEL.EQ.1.OR.NBGS.EQ.1) THEN
  320. N1PTEL=1
  321. ELSE
  322. N1PTEL=NBGS
  323. ENDIF
  324. NBPTEL=N1PTEL
  325. C NEL=N1EL
  326. C
  327. C CREATION DU MCHAML DE LA SOUS ZONE
  328. C
  329. if (ifomod.eq.6) then
  330. NSTRS = ndef + ndefac
  331. endif
  332. N2=NSTRS
  333. SEGINI MCHAML
  334. ICHAML(ISOUS)=MCHAML
  335. NS=1
  336. NCOSOU=NSTRS
  337. SEGINI MPTVAL
  338. IVAEPS=MPTVAL
  339. NOMID=MOEPSI
  340. SEGACT NOMID
  341. DO 100 ICOMP=1,NSTRS
  342. if (ifomod.eq.6) then
  343. if (icomp.le.ndef) then
  344. NOMCHE(ICOMP)=LESOBL(ICOMP)
  345. else
  346. NOMCHE(ICOMP)=LESFAC(ICOMP - ndef)
  347. endif
  348. else
  349. NOMCHE(ICOMP)=LESOBL(ICOMP)
  350. endif
  351. TYPCHE(ICOMP)='REAL*8'
  352. N2PTEL=0
  353. N2EL=0
  354. SEGINI MELVAL
  355. IELVAL(ICOMP)=MELVAL
  356. IVAL(ICOMP) =MELVAL
  357. 100 CONTINUE
  358. SEGDES NOMID
  359. C
  360. C en cas de derive de truesdell et de Jaumann il faudra calculer des
  361. C des contraintes donc on a besoin de la loi de hooke ou des
  362. C caracteristiques materiau ( young ...)
  363. C
  364. C____________________________________________________________________
  365. C
  366. C RANGEMENT DE LA MATRICE DE HOOKE DANS UN TABLEAU DE TRAVAIL *
  367. C____________________________________________________________________
  368. C
  369. IF( IDERI.EQ.3.or.IDERI.eq.4) THEN
  370. C Cas de la derivee de Truesdell ou Jaumann
  371. IF (IPCHA1 .EQ. 0) THEN
  372. CALL ERREUR(404)
  373. RETURN
  374. ENDIF
  375.  
  376. IF(LNOMID(3).NE.0) then
  377. MOGRAD=LNOMID(3)
  378. NOMID=MOGRAD
  379. SEGACT,NOMID
  380. NGRA=LESOBL(/2)
  381. segdes nomid
  382. ELSE
  383. CALL IDGRAD(MFR,IFOUR,MOGRAD,NGRA,NFAC)
  384. NOMID=MOGRAD
  385. SEGACT,NOMID
  386. NGRA=LESOBL(/2)
  387. segdes nomid
  388. ENDIF
  389. if(lnomid(4).ne.0) then
  390. nomid=lnomid(4)
  391. segact nomid
  392. mostrs=nomid
  393. nstr=lesobl(/2)
  394. nfac=lesfac(/2)
  395. else
  396. CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC)
  397. endif
  398. nomid=mostrs
  399. segact nomid
  400. lsupma=.true.
  401. nbrobl=0
  402. nbrfac=0
  403. momatr=0
  404. IF (IMAT.EQ.2) THEN
  405. IF(MELE.EQ.93.AND.CMATE.NE.'ISOTROPE')THEN
  406. NBROBL=3
  407. NBRFAC=0
  408. SEGINI NOMID
  409. LESOBL(1)='MAHO'
  410. LESOBL(2)='V1X '
  411. LESOBL(3)='V1Y '
  412. ELSE
  413. NBROBL=1
  414. NBRFAC=0
  415. SEGINI NOMID
  416. LESOBL(1)='MAHO'
  417. ENDIF
  418. MOMATR=NOMID
  419. NMATR=NBROBL
  420. NMATF=NBRFAC
  421. IF(MELE.EQ.93.AND.CMATE.NE.'ISOTROPE')THEN
  422. NBTYPE=3
  423. SEGINI NOTYPE
  424. TYPE(1)='POINTEURLISTREEL'
  425. TYPE(2)='REAL*8'
  426. TYPE(3)='REAL*8'
  427. ELSE
  428. NBTYPE=1
  429. SEGINI NOTYPE
  430. TYPE(1)='POINTEURLISTREEL'
  431. ENDIF
  432. MOTYPE=NOTYPE
  433. CALL KOMCHA(IPCHA2,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  434. SEGSUP NOTYPE
  435. IF (IERR.NE.0) GOTO 9990
  436. MPTVAL=IVAMAT
  437. MELVAL=IVAL(1)
  438. NBGMAT=IELCHE(/1)
  439. NELMAT=IELCHE(/2)
  440. NMATT=NMATR+NMATF
  441. ELSE
  442. C____________________________________________________________________
  443. C
  444. C SINON TRAITEMENT DES CHAMPS DE MATERIAU
  445. C aussi obligatoire en massifb pour truesdell et jaumann
  446. C____________________________________________________________________
  447. C
  448. IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'ISOTROPE') THEN
  449. NBROBL=2
  450. NBRFAC=0
  451. SEGINI NOMID
  452. MOMATR=NOMID
  453. IF (MFR.EQ.35.or.mfr.eq.78) THEN
  454. LESOBL(1)='KS '
  455. LESOBL(2)='KN '
  456. ELSE IF(MFR.EQ.53) THEN
  457. NBROBL=1
  458. SEGADJ,NOMID
  459. LESOBL(1)='KS '
  460. ELSE
  461. LESOBL(1)='YOUN'
  462. LESOBL(2)='NU '
  463. ENDIF
  464. NMATR=NBROBL
  465. NMATF=NBRFAC
  466. ELSEIF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'UNIDIREC') THEN
  467. IF (MFR.EQ.1.AND.IDIM.EQ.3) THEN
  468. NBROBL=7
  469. NBRFAC=0
  470. SEGINI NOMID
  471. MOMATR=NOMID
  472. LESOBL(1)='YOUN'
  473. LESOBL(2)='V1X '
  474. LESOBL(3)='V1Y '
  475. LESOBL(4)='V1Z '
  476. LESOBL(5)='V2X '
  477. LESOBL(6)='V2Y '
  478. LESOBL(7)='V2Z '
  479. ELSE
  480. NBROBL=3
  481. NBRFAC=0
  482. SEGINI NOMID
  483. MOMATR=NOMID
  484. LESOBL(1)='YOUN'
  485. LESOBL(2)='V1X '
  486. LESOBL(3)='V1Y '
  487. ENDIF
  488. NMATR=NBROBL
  489. NMATF=NBRFAC
  490. ELSEIF (FORMOD(1).EQ.'POREUX '.AND.CMATE.EQ.'ISOTROPE') THEN
  491. IF (MELE.GE.79.AND.MELE.LE.83) THEN
  492. NBROBL=4
  493. NBRFAC=0
  494. SEGINI NOMID
  495. MOMATR=NOMID
  496. LESOBL(1)='YOUN'
  497. LESOBL(2)='NU '
  498. LESOBL(3)='COB '
  499. LESOBL(4)='MOB '
  500. ELSE IF (MELE.GE.108.AND.MELE.LE.110) THEN
  501. NBROBL=4
  502. NBRFAC=0
  503. SEGINI NOMID
  504. MOMATR=NOMID
  505. LESOBL(1)='KS '
  506. LESOBL(2)='KN '
  507. LESOBL(3)='COB '
  508. LESOBL(4)='MOB '
  509. ELSE IF (MELE.GE.173.AND.MELE.LE.177) THEN
  510. NBROBL=10
  511. NBRFAC=0
  512. SEGINI NOMID
  513. MOMATR=NOMID
  514. LESOBL(1)='YOUN'
  515. LESOBL(2)='NU '
  516. LESOBL(3)='COP1'
  517. LESOBL(4)='COP2'
  518. LESOBL(5)='CPP1'
  519. LESOBL(6)='CPP2'
  520. LESOBL(7)='KK11'
  521. LESOBL(8)='KK12'
  522. LESOBL(9)='KK21'
  523. LESOBL(10)='KK22'
  524. ELSE IF (MELE.GE.178.AND.MELE.LE.182) THEN
  525. NBROBL=17
  526. NBRFAC=0
  527. SEGINI NOMID
  528. MOMATR=NOMID
  529. LESOBL(1)='YOUN'
  530. LESOBL(2)='NU '
  531. LESOBL(3)='COP1'
  532. LESOBL(4)='COP2'
  533. LESOBL(5)='COP3'
  534. LESOBL(6)='CPP1'
  535. LESOBL(7)='CPP2'
  536. LESOBL(8)='CPP3'
  537. LESOBL(9)='KK11'
  538. LESOBL(10)='KK12'
  539. LESOBL(11)='KK13'
  540. LESOBL(12)='KK21'
  541. LESOBL(13)='KK22'
  542. LESOBL(14)='KK23'
  543. LESOBL(15)='KK31'
  544. LESOBL(16)='KK32'
  545. LESOBL(17)='KK33'
  546. ELSE IF (MELE.GE.185.AND.MELE.LE.187) THEN
  547. NBROBL=10
  548. NBRFAC=0
  549. SEGINI NOMID
  550. MOMATR=NOMID
  551. LESOBL(1)='KS '
  552. LESOBL(2)='KN '
  553. LESOBL(3)='COP1'
  554. LESOBL(4)='COP2'
  555. LESOBL(5)='CPP1'
  556. LESOBL(6)='CPP2'
  557. LESOBL(7)='KK11'
  558. LESOBL(8)='KK12'
  559. LESOBL(9)='KK21'
  560. LESOBL(10)='KK22'
  561. ELSE IF (MELE.GE.188.AND.MELE.LE.190) THEN
  562. NBROBL=17
  563. NBRFAC=0
  564. SEGINI NOMID
  565. MOMATR=NOMID
  566. LESOBL(1)='KS '
  567. LESOBL(2)='KN '
  568. LESOBL(3)='COP1'
  569. LESOBL(4)='COP2'
  570. LESOBL(5)='COP3'
  571. LESOBL(6)='CPP1'
  572. LESOBL(7)='CPP2'
  573. LESOBL(8)='CPP3'
  574. LESOBL(9)='KK11'
  575. LESOBL(10)='KK12'
  576. LESOBL(11)='KK13'
  577. LESOBL(12)='KK21'
  578. LESOBL(13)='KK22'
  579. LESOBL(14)='KK23'
  580. LESOBL(15)='KK31'
  581. LESOBL(16)='KK32'
  582. LESOBL(17)='KK33'
  583. ENDIF
  584. NMATR=NBROBL
  585. NMATF=NBRFAC
  586. C
  587. ELSEIF(INAT.EQ.67.AND.CMATE.EQ.'ORTHOTRO') THEN
  588. NBROBL=6
  589. NBRFAC=0
  590. SEGINI NOMID
  591. MOMATR=NOMID
  592. LESOBL(1)='YG1 '
  593. LESOBL(2)='YG2 '
  594. LESOBL(3)='NU12'
  595. LESOBL(4)='G12 '
  596. LESOBL(5)='V1X '
  597. LESOBL(6)='V1Y '
  598. NMATR=NBROBL
  599. C Autres cas :
  600. ELSE
  601. if(lnomid(6).ne.0) then
  602. nomid=lnomid(6)
  603. segact nomid
  604. momatr=nomid
  605. nmatr=lesobl(/2)
  606. nmatf=lesfac(/2)
  607. lsupma=.false.
  608. else
  609. lsupma=.true.
  610. CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  611. endif
  612. ENDIF
  613. C
  614. C IF (CMATE.EQ.'SECTION') THEN
  615. C NBTYPE=3
  616. C SEGINI NOTYPE
  617. C TYPE(1)='POINTEURMMODEL'
  618. C TYPE(2)='POINTEURMCHAML'
  619. C TYPE(3)='POINTEURLISTREEL'
  620. C ELSE
  621. NBTYPE=1
  622. SEGINI NOTYPE
  623. TYPE(1)='REAL*8'
  624. C ENDIF
  625. MOTYPE=NOTYPE
  626. C
  627. CALL KOMCHA(IPCHA1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  628. SEGSUP NOTYPE
  629. IF (IERR.NE.0) GOTO 9990
  630. C
  631. NMATT=NMATR+NMATF
  632. C C
  633. IF(ISUP1.EQ.1)THEN
  634. CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  635. IF(IERR.NE.0)THEN
  636. ISUP1=0
  637. GOTO 9990
  638. ENDIF
  639. ENDIF
  640. MPTVAL=IVAMAT
  641. NBGMAT = 0
  642. NELMAT = 0
  643. DO 11081 IM=1,NMATT
  644. IF(IVAL(IM).NE.0)THEN
  645. MELVAL=IVAL(IM)
  646. IF (CMATE.EQ.'SECTION') THEN
  647. NBGMAT=MAX(NBGMAT,IELCHE(/1))
  648. NELMAT=MAX(NELMAT,IELCHE(/2))
  649. ELSE
  650. NBGMAT=MAX(NBGMAT,VELCHE(/1))
  651. NELMAT=MAX(NELMAT,VELCHE(/2))
  652. ENDIF
  653. ENDIF
  654. 11081 CONTINUE
  655. ENDIF
  656. nmattd=nmatt
  657. ivamtd= ivamat
  658. ENDIF
  659. segdes nomid
  660. C_______________________________________________________________________
  661. C
  662. C TRAITEMENT DES CHAMP CARACTERISTIQUES
  663. C_______________________________________________________________________
  664. C
  665. NBROBL=0
  666. NBRFAC=0
  667. IVECT =0
  668. C
  669. C EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES
  670. C
  671. IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  672. NBROBL=1
  673. NBRFAC=1
  674. SEGINI NOMID
  675. MOCARA=NOMID
  676. LESOBL(1)='EPAI'
  677. LESFAC(1)='EXCE'
  678. C
  679. NBTYPE=1
  680. SEGINI NOTYPE
  681. TYPE(1)='REAL*8'
  682. C
  683. C SECTION POUR LES BARRES
  684. C
  685. ELSE IF (MFR.EQ.27) THEN
  686. IF(.NOT.dcmate) THEN
  687.  
  688. NBROBL=1
  689. SEGINI NOMID
  690. MOCARA=NOMID
  691. LESOBL(1)='SECT'
  692. C
  693. NBTYPE=1
  694. SEGINI NOTYPE
  695. TYPE(1)='REAL*8'
  696. ENDIF
  697. C
  698. C section, excentrements et orientation pour les barres excentrees
  699. C
  700. ELSE IF (MFR.EQ.49) THEN
  701. NBROBL=6
  702. SEGINI NOMID
  703. MOCARA=NOMID
  704. LESOBL(1)='SECT'
  705. LESOBL(2)='EXCZ'
  706. LESOBL(3)='EXCY'
  707. LESOBL(4)='VX '
  708. LESOBL(5)='VY '
  709. LESOBL(6)='VZ '
  710. C
  711. NBTYPE=1
  712. SEGINI NOTYPE
  713. TYPE(1)='REAL*8'
  714. C
  715. C raideurs locales et orientation pour l'element LIA2
  716. C de liaison a 2 noeuds
  717. C
  718. ELSE IF (MFR.EQ.51) THEN
  719. NBROBL=9
  720. SEGINI NOMID
  721. MOCARA=NOMID
  722. LESOBL(1)='RLUX'
  723. LESOBL(2)='RLUY'
  724. LESOBL(3)='RLUZ'
  725. LESOBL(4)='RLRX'
  726. LESOBL(5)='RLRY'
  727. LESOBL(6)='RLRZ'
  728. LESOBL(7)='VX '
  729. LESOBL(8)='VY '
  730. LESOBL(9)='VZ '
  731. C
  732. NBTYPE=1
  733. SEGINI NOTYPE
  734. TYPE(1)='REAL*8'
  735. C
  736. C CARACTERISTIQUE POUR LES POUTRES
  737. C
  738. ELSE IF (MFR.EQ.7) THEN
  739. IF(.NOT.dcmate) THEN
  740. IF (CMATE.EQ.'SECTION') THEN
  741. NBROBL=0
  742. NBRFAC=1
  743. SEGINI NOMID
  744. MOCARA=NOMID
  745. LESFAC(1)='VECT'
  746. IVECT=1
  747. C
  748. NBTYPE=1
  749. SEGINI NOTYPE
  750. TYPE(1)='POINTEURPOINT '
  751. ELSE
  752. IF(IFOUR.EQ.2) THEN
  753. NBROBL=4
  754. NBRFAC=3
  755. SEGINI NOMID
  756. MOCARA=NOMID
  757. LESOBL(1)='TORS'
  758. LESOBL(2)='INRY'
  759. LESOBL(3)='INRZ'
  760. LESOBL(4)='SECT'
  761. LESFAC(1)='SECY'
  762. LESFAC(2)='SECZ'
  763. LESFAC(3)='VECT'
  764. IVECT=1
  765. C
  766. NBTYPE=7
  767. SEGINI NOTYPE
  768. TYPE(1)='REAL*8'
  769. TYPE(2)='REAL*8'
  770. TYPE(3)='REAL*8'
  771. TYPE(4)='REAL*8'
  772. TYPE(5)='REAL*8'
  773. TYPE(6)='REAL*8'
  774. TYPE(7)='POINTEURPOINT '
  775. ELSEIF(IFOUR.EQ.-1.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.63) THEN
  776. NBRFAC=1
  777. NBROBL=2
  778. SEGINI NOMID
  779. MOCARA=NOMID
  780. LESOBL(1)= 'SECT'
  781. LESOBL(2)= 'INRZ'
  782. LESFAC(1)= 'SECY'
  783. C
  784. NBTYPE=1
  785. SEGINI NOTYPE
  786. TYPE(1)='REAL*8'
  787. ENDIF
  788. ENDIF
  789. ENDIF
  790. C
  791. C TIMO 2D
  792. C
  793. C ELSE IF ((MFR.EQ.7).AND.
  794. C & (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3)) THEN
  795. C
  796. C IF (CMATE.NE.'SECTION') THEN
  797. C ENDIF
  798. C
  799. C CARACTERISTIQUE POUR LES TUYAUX
  800. C
  801. ELSE IF (MFR.EQ.13) THEN
  802. NBROBL=2
  803. NBRFAC=3
  804. SEGINI NOMID
  805. MOCARA=NOMID
  806. LESOBL(1)='EPAI'
  807. LESOBL(2)='RAYO'
  808. LESFAC(1)='RACO'
  809. LESFAC(2)='CISA'
  810. LESFAC(3)='VECT'
  811. IVECT=1
  812. C
  813. NBTYPE=5
  814. SEGINI NOTYPE
  815. TYPE(1)='REAL*8'
  816. TYPE(2)='REAL*8'
  817. TYPE(3)='REAL*8'
  818. TYPE(4)='REAL*8'
  819. TYPE(5)='POINTEURPOINT '
  820. C
  821. C CARACTERISTIQUE POUR LES LINESPRING
  822. C
  823. ELSE IF (MFR.EQ.15) THEN
  824. NBROBL=5
  825. SEGINI NOMID
  826. MOCARA=NOMID
  827. LESOBL(1)='EPAI'
  828. LESOBL(2)='FISS'
  829. LESOBL(3)='VX '
  830. LESOBL(4)='VY '
  831. LESOBL(5)='VZ '
  832. C
  833. NBTYPE=1
  834. SEGINI NOTYPE
  835. TYPE(1)='REAL*8'
  836. C
  837. C CARACTERISTIQUE POUR LES TUYAUX FISSURES
  838. C
  839. ELSE IF (MFR.EQ.17) THEN
  840. NBROBL=9
  841. SEGINI NOMID
  842. MOCARA=NOMID
  843. LESOBL(1)='RAYO'
  844. LESOBL(2)='EPAI'
  845. LESOBL(3)='VX '
  846. LESOBL(4)='VY '
  847. LESOBL(5)='VZ '
  848. LESOBL(6)='VXF '
  849. LESOBL(7)='VYF '
  850. LESOBL(8)='VZF '
  851. LESOBL(9)='ANGL'
  852. C
  853. NBTYPE=1
  854. SEGINI NOTYPE
  855. TYPE(1)='REAL*8'
  856. C
  857. C CARACTERISTIQUE POUR LES ELEMENTS HOMOGENEISES
  858. C
  859. ELSE IF (MFR.EQ.37) THEN
  860. IF (IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN
  861. NBROBL=4
  862. SEGINI NOMID
  863. MOCARA=NOMID
  864. LESOBL(1)='SCEL'
  865. LESOBL(2)='SFLU'
  866. LESOBL(3)='EPS '
  867. LESOBL(4)='XINE'
  868. ELSE
  869. NBROBL=3
  870. SEGINI NOMID
  871. MOCARA=NOMID
  872. LESOBL(1)='SCEL'
  873. LESOBL(2)='SFLU'
  874. LESOBL(3)='EPS '
  875. ENDIF
  876. C
  877. NBTYPE=1
  878. SEGINI NOTYPE
  879. TYPE(1)='REAL*8'
  880. C
  881. C CARACTERISTIQUE POUR LES JOINTS GENE
  882. C
  883. ELSE IF (MFR.EQ.55) THEN
  884. CcPPj NBROBL=1
  885. CcPPj NBRFAC=0
  886. CcPPj SEGINI NOMID
  887. CcPPj MOCARA=NOMID
  888. CcPPj LESOBL(1)='EPAI'
  889. NBROBL=0
  890. NBRFAC=1
  891. SEGINI NOMID
  892. MOCARA=NOMID
  893. LESFAC(1)='EPAI'
  894. C
  895. NBTYPE=1
  896. SEGINI NOTYPE
  897. TYPE(1)='REAL*8'
  898. C
  899. ENDIF
  900. C
  901. NCARA=NBROBL
  902. NCARF=NBRFAC
  903. NCARR=NCARA+NCARF
  904. C
  905. IF (MOCARA.NE.0) THEN
  906. IF (IPCHA1.EQ.0) THEN
  907. SEGSUP,NOTYPE
  908. MOTERR(1:8)='CARACTER'
  909. MOTERR(9:12)=NOMTP(MELE)
  910. MOTERR(13:20)='EPSI'
  911. CALL ERREUR(145)
  912. GOTO 9990
  913. ENDIF
  914. MOTYPE=NOTYPE
  915. CALL KOMCHA(IPCHA1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS
  916. $ ,3,IVACAR)
  917. SEGSUP NOTYPE
  918. IF (IERR.NE.0) GOTO 9990
  919. IF (IVECT.EQ.1) THEN
  920. MPTVAL=IVACAR
  921. IF (IVAL(NCARR).EQ.0) THEN
  922. C
  923. C MOT CLE VECT EN CAS DE CONVERSION
  924. C
  925. segsup mptval
  926. IVECT=2
  927. NOMID=MOCARA
  928. C* SEGACT NOMID
  929. NBRFAC=NBRFAC+2
  930. SEGADJ NOMID
  931. LESFAC(NBRFAC-2)='VX '
  932. LESFAC(NBRFAC-1)='VY '
  933. LESFAC(NBRFAC) ='VZ '
  934. C
  935. NCARF=NBRFAC
  936. NCARR=NCARA+NCARF
  937. C
  938. NBTYPE=1
  939. SEGINI,NOTYPE
  940. TYPE(1)='REAL*8'
  941. MOTYPE=NOTYPE
  942. C
  943. CALL KOMCHA(IPCHA1,IPMAIL,CONM,MOCARA,MOTYPE,
  944. $ 1,INFOS,3,IVACAR)
  945. SEGSUP NOTYPE
  946. IF (IERR.NE.0) GOTO 9990
  947. ENDIF
  948. ENDIF
  949. SEGDES NOMID
  950. IF(ISUP1.EQ.1)THEN
  951. CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  952. IF(IERR.NE.0)THEN
  953. ISUP1=0
  954. GOTO 9990
  955. ENDIF
  956. ENDIF
  957. ENDIF
  958. C____________________________________________________________________
  959. C
  960. C RANGEMENT DE LA MATRICE DE HOOKE DANS UN TABLEAU DE TRAVAIL *
  961. C UNIQUEMENT DANS LE CAS DE L'ELEMENT COQUE DST
  962. C____________________________________________________________________
  963. C
  964. NMATR=0
  965. NMATF=0
  966. NMATT=0
  967. NBGMAT=0
  968. NELMAT=0
  969. IF(MELE.EQ.93.and.INAT.EQ.2) THEN
  970. IF(CMATE.NE.'ISOTROPE')THEN
  971. NBROBL=3
  972. NBRFAC=0
  973. SEGINI NOMID
  974. LESOBL(1)='MAHO'
  975. LESOBL(2)='V1X '
  976. LESOBL(3)='V1Y '
  977. ELSE
  978. NBROBL=1
  979. NBRFAC=0
  980. SEGINI NOMID
  981. LESOBL(1)='MAHO'
  982. ENDIF
  983. MOMATR=NOMID
  984. NMATR=NBROBL
  985. NMATF=NBRFAC
  986. NMATT=NMATR+NMATF
  987. IF(CMATE.NE.'ISOTROPE')THEN
  988. NBTYPE=3
  989. SEGINI NOTYPE
  990. TYPE(1)='POINTEURLISTREEL'
  991. TYPE(2)='REAL*8'
  992. TYPE(3)='REAL*8'
  993. ELSE
  994. NBTYPE=1
  995. SEGINI NOTYPE
  996. TYPE(1)='POINTEURLISTREEL'
  997. ENDIF
  998. MOTYPE=NOTYPE
  999. CALL KOMCHA(IPCHA2,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  1000. SEGSUP NOTYPE
  1001. IF (IERR.NE.0) GOTO 9990
  1002. MPTVAL=IVAMAT
  1003. MELVAL=IVAL(1)
  1004. NBGMAT=IELCHE(/1)
  1005. NELMAT=IELCHE(/2)
  1006. ENDIF
  1007. C____________________________________________________________________
  1008. C
  1009. C SINON TRAITEMENT DES CHAMPS DE MATERIAU
  1010. C____________________________________________________________________
  1011. C
  1012. IF((MELE.EQ.93.and.inat.ne.2).or.
  1013. $ (mfr.eq.7.and.CMATE.NE.'SECTION'.and.(.not.dcmate))
  1014. $.or.mfr.eq.13)THEN
  1015. IF ((FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'ISOTROPE')
  1016. $ .or.mfr.eq.7) THEN
  1017. NBROBL=2
  1018. NBRFAC=0
  1019. SEGINI NOMID
  1020. MOMATR=NOMID
  1021. LESOBL(1)='YOUN'
  1022. LESOBL(2)='NU '
  1023. NMATR=NBROBL
  1024. NMATF=NBRFAC
  1025. ELSEIF(FORMOD(1).EQ.'MECANIQUE'.AND.(CMATE.EQ.'ORTHOTRO'))THEN
  1026. IF(INAT.EQ.67) THEN
  1027. NBROBL=6
  1028. NBRFAC=0
  1029. SEGINI NOMID
  1030. MOMATR=NOMID
  1031. LESOBL(1)='YG1 '
  1032. LESOBL(2)='YG2 '
  1033. LESOBL(3)='NU12'
  1034. LESOBL(4)='G12 '
  1035. LESOBL(5)='V1X '
  1036. LESOBL(6)='V1Y '
  1037. NMATR=NBROBL
  1038. NMATF=NBRFAC
  1039. ELSE
  1040. if(lnomid(6).ne.0) then
  1041. lsupma=.false.
  1042. nomid=lnomid(6)
  1043. segact nomid
  1044. momatr=nomid
  1045. nmatr=lesobl(/2)
  1046. nmatf=lesfac(/2)
  1047. else
  1048. CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  1049. nomid=MOMATR
  1050. endif
  1051. ENDIF
  1052. ELSE
  1053. CALL ERREUR(19)
  1054. GOTO 9990
  1055. ENDIF
  1056. NMATT=NMATR+NMATF
  1057. C
  1058. NBTYPE=1
  1059. SEGINI NOTYPE
  1060. TYPE(1)='REAL*8'
  1061. MOTYPE=NOTYPE
  1062. C
  1063. CALL KOMCHA(IPCHA1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  1064. SEGSUP NOTYPE
  1065. IF (IERR.NE.0) GOTO 9990
  1066. C
  1067. IF(ISUP1.EQ.1)THEN
  1068. CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  1069. IF(IERR.NE.0)THEN
  1070. ISUP1=0
  1071. GOTO 9990
  1072. ENDIF
  1073. ENDIF
  1074. C
  1075. MPTVAL=IVAMAT
  1076. NBGMAT = 0
  1077. NELMAT = 0
  1078. DO 1108 IM=1,NMATT
  1079. IF(IVAL(IM).NE.0)THEN
  1080. MELVAL=IVAL(IM)
  1081. IF (CMATE.EQ.'SECTION') THEN
  1082. NBGMAT=MAX(NBGMAT,IELCHE(/1))
  1083. NELMAT=MAX(NELMAT,IELCHE(/2))
  1084. ELSE
  1085. NBGMAT=MAX(NBGMAT,VELCHE(/1))
  1086. NELMAT=MAX(NELMAT,VELCHE(/2))
  1087. ENDIF
  1088. ENDIF
  1089. 1108 CONTINUE
  1090. ENDIF
  1091. C================================================
  1092. C
  1093. C CAS D'UN JOINT UNIDIMENSIONNEL JOI1
  1094. C Chargement des vecteurs situes dans les caracteristiques materiau
  1095. C
  1096. C================================================
  1097. IF(MFR.EQ.75) THEN
  1098. IF(IDIM.EQ.3) THEN
  1099. NBROBL=6
  1100. NBRFAC=0
  1101. SEGINI NOMID
  1102. MOMATR=NOMID
  1103. LESOBL(1)='V1X'
  1104. LESOBL(2)='V1Y'
  1105. LESOBL(3)='V1Z'
  1106. LESOBL(4)='V2X'
  1107. LESOBL(5)='V2Y'
  1108. LESOBL(6)='V2Z'
  1109. NMATR=NBROBL
  1110. NMATF=NBRFAC
  1111. ELSE IF(IDIM.EQ.2) THEN
  1112. NBROBL=2
  1113. NBRFAC=0
  1114. SEGINI NOMID
  1115. MOMATR=NOMID
  1116. LESOBL(1)='V1X'
  1117. LESOBL(2)='V1Y'
  1118. NMATR=NBROBL
  1119. NMATF=NBRFAC
  1120. ENDIF
  1121. NBTYPE=1
  1122. SEGINI NOTYPE
  1123. TYPE(1)='REAL*8'
  1124. MOTYPE=NOTYPE
  1125. C
  1126. CALL KOMCHA(IPCHA1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  1127. SEGSUP NOTYPE
  1128. IF (IERR.NE.0) GOTO 9990
  1129. C
  1130. NMATT=NMATR+NMATF
  1131. C C
  1132. IF(ISUP1.EQ.1)THEN
  1133. CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  1134. IF(IERR.NE.0)THEN
  1135. ISUP1=0
  1136. GOTO 9990
  1137. ENDIF
  1138. ENDIF
  1139. MPTVAL=IVAMAT
  1140. NBGMAT = 0
  1141. NELMAT = 0
  1142. DO 11265 IM=1,NMATT
  1143. IF(IVAL(IM).NE.0)THEN
  1144. MELVAL=IVAL(IM)
  1145. IF (CMATE.EQ.'SECTION') THEN
  1146. NBGMAT=MAX(NBGMAT,IELCHE(/1))
  1147. NELMAT=MAX(NELMAT,IELCHE(/2))
  1148. ELSE
  1149. NBGMAT=MAX(NBGMAT,VELCHE(/1))
  1150. NELMAT=MAX(NELMAT,VELCHE(/2))
  1151. ENDIF
  1152. ENDIF
  1153. 11265 CONTINUE
  1154. nmattd=nmatt
  1155. ivamtd= ivamat
  1156. segdes nomid
  1157. ENDIF
  1158. C
  1159. C
  1160. C=======================================================================
  1161. C NUMERO DES ETIQUETTES :
  1162. C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  1163. C ON DIRIGE DANS 3 SOUS-PROGRAMMES SELON LES ELEMENTS
  1164. C
  1165. C - massif, poreux, joints poreux ------------------> epsi2
  1166. C - coq3,dkt,coq4,coq8,coq2,joints -----------------> epsi3
  1167. C - poutre,tuyau,linespring,tuyau fissure,barre ----> epsi4
  1168. C - elements XFEM (mfr = 63) -----------------------> epsix
  1169. C
  1170. C=======================================================================
  1171. IF (MELE.LE.100)
  1172. &GOTO (99,29,99, 4,99, 4,99, 4,99, 4,99,99,99, 4, 4, 4, 4,99,99,99,
  1173. 1 99,99, 4, 4, 4, 4,27,27,27,29,99,99,99,99,99,99,99,99,99,99,
  1174. 2 27,27,29,27,29,29,99,99,27,29,99,99,99,99,99,27,99,99,99,99,
  1175. 3 99,99,99,99,99,99,99,99, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
  1176. 4 4, 4, 4,27,27,27,27,27,99,99,99,99,27,99,29,29,99,99,99,99
  1177. 5 ),MELE
  1178. IF (MELE.LE.200)
  1179. &GOTO (99,99,99,99,99,99,99, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
  1180. 1 4, 4,29,29,29,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,
  1181. 2 34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,
  1182. 3 34,34,34,34,34,34,34,27,27,27,27,27, 4, 4, 4, 4, 4, 4, 4, 4,
  1183. 4 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,34,34, 4, 4,34,34,34,34,34,34
  1184. 5 ),MELE-100
  1185. IF (MELE.LE.300)
  1186. &GOTO (34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,
  1187. 1 34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,
  1188. 2 34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,27,34,27,
  1189. c cccccc
  1190. 3 34,34,63,63,29,29,29,29,99,99,29,29, 4, 4),MELE-200
  1191. c cccccc
  1192. C
  1193. 34 CONTINUE
  1194. 99 CONTINUE
  1195. MOTERR(1:4) =NOMTP(MELE)
  1196. MOTERR(5:12)='EPSI'
  1197. CALL ERREUR(86)
  1198. GOTO 9990
  1199. C_______________________________________________________________________
  1200. C
  1201. C massifs, poreux et joints poreux
  1202. C_______________________________________________________________________
  1203. C
  1204. 4 CONTINUE
  1205. CALL EPSI2(IPMAIL,IPMINT,MELE,IELE,
  1206. & IVADEP,NBPTEL,LRE,NSTRS,LHOOK,
  1207. & MFR,NDEP,IPORE,IREPS2,NBPGAU,IVAEPS,UZDPG,RYDPG,RXDPG,IIPDPG,
  1208. & ideri,IVAMTD,ivade2,mate,nmattD,cmate,ngra,noer,kerr)
  1209. GOTO 9990
  1210. C_______________________________________________________________________
  1211. C
  1212. C poutres,tuyau,coq3,dkt,coq4,coq8,coq2 ,dst,joint 3D,joints 2D
  1213. C_______________________________________________________________________
  1214. C
  1215. 27 CONTINUE
  1216. if (dcmate) goto 29
  1217. CALL EPSI3(IPMAIL,IVADEP,IVACAR,NELMAT,NBGMAT,IVECT,
  1218. & IVAMAT,LHOOK,IMAT,MATE,CMATE,NMATT,NSTRS,MFR,IPMINT,
  1219. & NCARR,NDEP,NBPGAU,NBPTEL,MELE,LRE,LW,IREPS2,IVAEPS,
  1220. & IPMIN1,UZDPG,RYDPG,RXDPG,NPINT,IIPDPG)
  1221. GOTO 9990
  1222. C_______________________________________________________________________
  1223. C
  1224. C linespring,tuyau fissure,barre,joi1,zone cohesive
  1225. C_______________________________________________________________________
  1226. C
  1227. 29 CONTINUE
  1228. CALL EPSI4(IPMAIL,IVADEP,NDEP,IVAMAT,NMATT,IVACAR,NCARR,IPMINT,
  1229. & IVECT,MELE,LHOOK,IREPS2,NBPTEL,NSTRS,MFR,
  1230. & NBPGAU,LRE,LW,IVAEPS,UZDPG,RYDPG,RXDPG,ISOUS,IIPDPG,cmate)
  1231. GOTO 9990
  1232. C_______________________________________________________________________
  1233. C
  1234. C Elements XFEM (MFR = 63)
  1235. C_______________________________________________________________________
  1236. C
  1237. 63 CONTINUE
  1238. CALL EPSIX (IMODEL,IREPS2,IVADEP,IVAEPS,
  1239. & UZDPG,RYDPG,RXDPG,IIPDPG,IRETER)
  1240. IF (IRETER.NE.0) RETURN
  1241. GO TO 9990
  1242. C_______________________________________________________________________
  1243. C
  1244. C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE IA
  1245. C_______________________________________________________________________
  1246. C
  1247. 9990 CONTINUE
  1248. C
  1249. IF(IMAT.NE.2.AND.ISUP1.EQ.1)THEN
  1250. CALL DTMVAL(IVAMAT,3)
  1251. ELSE
  1252. CALL DTMVAL(IVAMAT,1)
  1253. ENDIF
  1254. C
  1255. IF(ISUP1.EQ.1)THEN
  1256. CALL DTMVAL(IVACAR,3)
  1257. ELSE
  1258. CALL DTMVAL(IVACAR,1)
  1259. ENDIF
  1260. C
  1261. IF(IERR.NE.0)THEN
  1262. SEGSUP MCHAML
  1263. CALL DTMVAL(IVAEPS,3)
  1264. ELSE
  1265. SEGDES MCHAML
  1266. mptval = ivaeps
  1267. do iv = 1, ival(/1)
  1268. ic1 = ival(iv)
  1269. call comred(ic1)
  1270. enddo
  1271. CALL DTMVAL(IVAEPS,1)
  1272. ENDIF
  1273. C
  1274. mptval = ivadep
  1275. do iv = 1, ival(/1)
  1276. ic1 = ival(iv)
  1277. C test pour les melval ?? 0 (=ceux des composantes facultatives et absentes)
  1278. if(ic1 .ne. 0) call comred(ic1)
  1279. enddo
  1280. CALL DTMVAL(IVADEP,1)
  1281. IF( IVADE2.NE.0) CALL DTMVAL(IVADE2,1)
  1282. C
  1283. 9993 CONTINUE
  1284. IF(MOMATR.NE.0)THEN
  1285. NOMID=MOMATR
  1286. if(lsupma)SEGSUP NOMID
  1287. ENDIF
  1288. C
  1289. IF(MOCARA.NE.0)THEN
  1290. NOMID=MOCARA
  1291. SEGSUP NOMID
  1292. ENDIF
  1293. C
  1294. IF(MOEPSI.NE.0)THEN
  1295. NOMID=MOEPSI
  1296. if(lsupde)SEGSUP NOMID
  1297. ENDIF
  1298. C
  1299. IF(MODEPL.NE.0)THEN
  1300. NOMID=MODEPL
  1301. if(lsupdp)SEGSUP NOMID
  1302. ENDIF
  1303. IF (IPMINT.NE.0) SEGDES,MINTE
  1304. SEGDES MELEME
  1305. 9992 CONTINUE
  1306. C
  1307. C DANS LE CAS D'ERREUR
  1308. C
  1309. IF (IERR.NE.0) GOTO 888
  1310. C
  1311. 500 CONTINUE
  1312. C
  1313. 888 CONTINUE
  1314. DO IJKL=1,NSOUS
  1315. IMODEL=KMODEL(IJKL)
  1316. SEGDES,IMODEL
  1317. ENDDO
  1318. SEGSUP,MMODEL
  1319. C
  1320. IF(IERR.NE.0)THEN
  1321. IRET = 0
  1322. SEGSUP MCHELM
  1323. IPEPSI = 0
  1324. ELSE
  1325. IRET = 1
  1326. SEGDES MCHELM
  1327. IPEPSI = MCHELM
  1328. ENDIF
  1329. CALL DTCHAM(IPCH1)
  1330.  
  1331. RETURN
  1332. END
  1333.  
  1334.  
  1335.  
  1336.  
  1337.  
  1338.  

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