Télécharger epsi1.eso

Retour à la liste

Numérotation des lignes :

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

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