Télécharger epsi1.eso

Retour à la liste

Numérotation des lignes :

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

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