Télécharger epsi1.eso

Retour à la liste

Numérotation des lignes :

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

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