Télécharger epsi1.eso

Retour à la liste

Numérotation des lignes :

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

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