Télécharger epsi1.eso

Retour à la liste

Numérotation des lignes :

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

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