Télécharger hotanp.eso

Retour à la liste

Numérotation des lignes :

  1. C HOTANP SOURCE AM 16/04/12 21:16:06 8903
  2. SUBROUTINE HOTANP(IPMODL,IPCHE1,IPCHE2,IPCHE3,XPREC,
  3. & DTPS,IPCHOT,IRET)
  4. *_______________________________________________________________________
  5. *
  6. * ENTREES :
  7. * ---------
  8. *
  9. * IPCHE1 pointeur sur le MCHAML de sous type CONTRAINTES
  10. * IPCHE2 pointeur sur le MCHAML de sous type VARIABLES INTERNES
  11. * IPCHE3 pointeur sur le MCHAML de sous type CARACTERISTIQUES
  12. * IPMODL pointeur sur l'objet de type MMODEL
  13. * XPREC flottant (par defaut 1.D-3)
  14. * DTPS flottant increment de temps pour les modèles visqueux
  15. *
  16. * SORTIES :
  17. * ---------
  18. *
  19. * IPCHOT pointeur sur le MCHAML de sous type MATRICE de HOOKE
  20. * TANGENTE
  21. * IRET 1 ou 0 suivant succes ou pas
  22. *
  23. * Passage aux nouveaux CHAMELEM par JM CAMPENON le 05/91
  24. *
  25. *_______________________________________________________________________
  26. IMPLICIT INTEGER(I-N)
  27. IMPLICIT REAL*8(A-H,O-Z)
  28. *
  29. -INC CCOPTIO
  30. -INC CCHAMP
  31. -INC SMCHAML
  32. -INC SMELEME
  33. -INC SMCOORD
  34. -INC SMMODEL
  35. -INC SMINTE
  36. -INC SMLREEL
  37. *
  38. *- Nombre de points maximal pour stocker une courbe de traction
  39. PARAMETER (LTRAC=2*75)
  40. *
  41. SEGMENT WRK1
  42. REAL*8 DDHOOK(NSTRS,NSTRS)
  43. REAL*8 DDHOMU(NSTRS,NSTRS)
  44. ENDSEGMENT
  45. *
  46. SEGMENT MIDON1
  47. REAL*8 XMAT(NCXMAT)
  48. ENDSEGMENT
  49. *
  50. SEGMENT MIDON2
  51. REAL*8 VAR(NVART)
  52. ENDSEGMENT
  53. *
  54. SEGMENT MIDON3
  55. REAL*8 XCAR(NCART)
  56. ENDSEGMENT
  57. *
  58. DIMENSION TRAC(LTRAC)
  59. *
  60. SEGMENT NOTYPE
  61. CHARACTER*16 TYPE(NBTYPE)
  62. ENDSEGMENT
  63. *
  64. SEGMENT MPTVAL
  65. INTEGER IPOS(NS) ,NSOF(NS)
  66. INTEGER IVAL(NCOSOU)
  67. CHARACTER*16 TYVAL(NCOSOU)
  68. ENDSEGMENT
  69. *
  70. CHARACTER*8 CMATE
  71. CHARACTER*(NCONCH) CONM
  72. PARAMETER ( NINF=3 )
  73. INTEGER INFOS(NINF)
  74. LOGICAL lsupva,lsupco
  75. *
  76. IRET = 0
  77. *
  78. NHRM=NIFOUR
  79. KERRE=0
  80. KPE =0
  81. *
  82. * Verification du lieu support du MCHAML de contraintes
  83. *
  84. CALL QUESUP(IPMODL,IPCHE1,3,0,ISUPCO,IRETCO)
  85. IF (ISUPCO.GT.1) RETURN
  86. *
  87. * Verification du lieu support du MCHAML de variables internes
  88. *
  89. CALL QUESUP(IPMODL,IPCHE2,3,0,ISUPVA,IRETVA)
  90. IF (ISUPVA.GT.1) RETURN
  91. *
  92. * Verification du lieu support du MCHAML de materiau
  93. *
  94. CALL QUESUP(IPMODL,IPCHE3,3,0,ISUPMA,IRETMA)
  95. IF (ISUPMA.GT.1) RETURN
  96. *
  97. * Activation du MMODEL
  98. *
  99. MMODEL=IPMODL
  100. SEGACT MMODEL
  101. NSOUS=KMODEL(/1)
  102. *
  103. * Creation du MCHELM de MATRICE DE HOOKE TANGENTE
  104. *
  105. N1=NSOUS
  106. L1=16
  107. N3=6
  108. SEGINI MCHELM
  109. IPCHOT=MCHELM
  110. TITCHE='MATRICE DE HOOKE'
  111. IFOCHE=IFOUR
  112. *
  113. * Boucle sur les sous zones du maillage
  114. *
  115. DO 100 ISOUS=1,NSOUS
  116. *
  117. * Traitement du modele
  118. *
  119. IPMOD1=KMODEL(ISOUS)
  120. IMODEL=IPMOD1
  121. SEGACT IMODEL
  122. IPMAIL=IMAMOD
  123. CONM =CONMOD
  124. IMACHE(ISOUS) = IPMAIL
  125. CONCHE(ISOUS) = CONMOD
  126. *
  127. MELE=NEFMOD
  128. MELEME=IMAMOD
  129. SEGACT MELEME
  130. NBNN=NUM(/1)
  131. NBELEM=NUM(/2)
  132. NFOR=FORMOD(/2)
  133. NMAT=MATMOD(/2)
  134. C
  135. C COQUE INTEGREE OU PAS ?
  136. C
  137. IF(INFMOD(/1).NE.0)THEN
  138. NPINT=INFMOD(1)
  139. ELSE
  140. NPINT=0
  141. ENDIF
  142. *
  143. * Nature du materiau
  144. *
  145. CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,MAPL)
  146. IF (CMATE.EQ.' ') THEN
  147. CALL ERREUR(251)
  148. SEGSUP MCHELM
  149. SEGDES MMODEL,IMODEL
  150. RETURN
  151. ENDIF
  152. *
  153. * Information sur l'element fini
  154. *
  155. * CALL ELQUOI(MELE,0,3,IPINF,IMODEL)
  156. * IF (IERR.NE.0) THEN
  157. * SEGDES IMODEL,MMODEL
  158. * SEGSUP MCHELM
  159. * RETURN
  160. * ENDIF
  161. MELE =INFELE(1)
  162. MFR =INFELE(13)
  163. IPPORE=0
  164. IF(MFR.EQ.33) IPPORE=NBNN
  165. NBG =INFELE(6)
  166. NBGS =INFELE(4)
  167. NSTRS=INFELE(16)
  168. LW =INFELE(7)
  169. LHOOK=INFELE(10)
  170. LHOO2=LHOOK*LHOOK
  171. ICARA=INFELE(5)
  172. * MINTE=INFELE(11)
  173. MINTE=INFMOD(5)
  174. IPMIN1=MINTE
  175. *
  176. * Creation du tableau INFOS ( contraintes et variables internes )
  177. *
  178. CALL IDENT(IPMAIL,CONM,IPCHE2,IPCHE1,INFOS,IRTD)
  179. IF (IRTD.EQ.0) THEN
  180. SEGDES IMODEL,MMODEL
  181. SEGSUP MCHELM
  182. RETURN
  183. ENDIF
  184. C
  185. INFCHE(ISOUS,1)=0
  186. INFCHE(ISOUS,2)=0
  187. INFCHE(ISOUS,3)=NHRM
  188. INFCHE(ISOUS,4)=MINTE
  189. INFCHE(ISOUS,5)=0
  190. INFCHE(ISOUS,6)=3
  191. *
  192. * Creation du MCHAML de HOOKE TANGENTE
  193. *
  194. N2=1
  195. SEGINI MCHAML
  196. ICHAML(ISOUS)=MCHAML
  197. NOMCHE(1)='MAHO'
  198. TYPCHE(1)='POINTEURLISTREEL'
  199. *
  200. IVAHOO=0
  201. WRK1=0
  202. MOCARA=0
  203. NCARA=0
  204. NCARF=0
  205. MOMATR=0
  206. NMATR=0
  207. NMATF=0
  208. MOVARI=0
  209. NVARI=0
  210. NVARF=0
  211. IVACAR=0
  212. IVAMAT=0
  213. IVARI=0
  214. IVACON=0
  215. C
  216. SEGACT,MINTE
  217. *
  218. * Traitement des champ de CONTRAINTES
  219. *
  220. if(lnomid(4).ne.0) then
  221. nomid=lnomid(4)
  222. segact nomid
  223. mocont=nomid
  224. nstrs=lesobl(/2)
  225. nfac=lesfac(/2)
  226. lsupco=.false.
  227. else
  228. lsupco=.true.
  229. CALL IDCONT(IMODEL,IFOUR,MOCONT,NSTRS,NFAC)
  230. endif
  231. IF (MOCONT.EQ.0) THEN
  232. MOTERR(1:4)='CONT'
  233. MOTERR(5:8)=NOMTP(MELE)
  234. CALL ERREUR (76)
  235. GOTO 9990
  236. ENDIF
  237. *
  238. NBTYPE=1
  239. SEGINI NOTYPE
  240. MOTYPE=NOTYPE
  241. TYPE(1)='REAL*8'
  242. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCONT,MOTYPE,1,INFOS,3,IVACON)
  243. SEGSUP NOTYPE
  244. IF (IERR.NE.0) GOTO 9990
  245. *
  246. IF (ISUPCO.EQ.1) THEN
  247. CALL VALCHE(IVACON,NSTRS,IPMIN1,IPPORE,MOCONT,MELE)
  248. ENDIF
  249. *
  250. * Traitement des champ de VARIABLES INTERNES
  251. *
  252. if(lnomid(10).ne.0) then
  253. nomid=lnomid(10)
  254. segact nomid
  255. movari=nomid
  256. nvari=lesobl(/2)
  257. nvarf=lesfac(/2)
  258. lsupva=.false.
  259. else
  260. lsupva=.true.
  261. CALL IDVARI(MFR,IPMOD1,MOVARI,NVARI,NVARF)
  262. endif
  263. IF (MOVARI.EQ.0) THEN
  264. MOTERR(1:4)='VARI'
  265. MOTERR(5:8)=NOMTP(MELE)
  266. CALL ERREUR (76)
  267. GOTO 9990
  268. ENDIF
  269. NVART=NVARI+NVARF
  270. *
  271. NBTYPE=1
  272. SEGINI NOTYPE
  273. MOTYPE=NOTYPE
  274. TYPE(1)='REAL*8'
  275. CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOVARI,MOTYPE,1,INFOS,3,IVARI)
  276. SEGSUP NOTYPE
  277. IF (IERR.NE.0) GOTO 9990
  278. *
  279. IF (ISUPVA.EQ.1) THEN
  280. CALL VALCHE(IVARI,NVART,IPMIN1,IPPORE,MOVARI,MELE)
  281. ENDIF
  282. *
  283. * Creation du tableau INFOS (variables internes,caracteristiques)
  284. *
  285. CALL IDENT(IPMAIL,CONM,IPCHE2,IPCHE3,INFOS,IRTE)
  286. IF (IRTE.EQ.0) GOTO 9990
  287. *
  288. * Traitement des champs de materiaux
  289. *
  290. NBROBL=0
  291. NBRFAC=0
  292. IF (CMATE.EQ.'ISOTROPE') THEN
  293. IF (MAPL.EQ.1) THEN
  294. NBROBL=3
  295. SEGINI NOMID
  296. MOMATR=NOMID
  297. LESOBL(1)='YOUN'
  298. LESOBL(2)='NU '
  299. LESOBL(3)='SIGY'
  300. *
  301. NBTYPE=1
  302. SEGINI NOTYPE
  303. MOTYPE=NOTYPE
  304. TYPE(1)='REAL*8'
  305. ELSE IF (MAPL.EQ.3) THEN
  306. NBROBL=4
  307. SEGINI NOMID
  308. MOMATR=NOMID
  309. LESOBL(1)='YOUN'
  310. LESOBL(2)='NU '
  311. LESOBL(3)='LTR '
  312. LESOBL(4)='LCS '
  313. *
  314. NBTYPE=1
  315. SEGINI NOTYPE
  316. MOTYPE=NOTYPE
  317. TYPE(1)='REAL*8'
  318. ELSE IF (MAPL.EQ.15) THEN
  319. NBROBL=11
  320. SEGINI NOMID
  321. MOMATR=NOMID
  322. LESOBL(1)='YOUN'
  323. LESOBL(2)='NU '
  324. LESOBL(3)='ETA '
  325. LESOBL(4)='MU '
  326. LESOBL(5)='KL '
  327. LESOBL(6)='GAMM'
  328. LESOBL(7)='DELT'
  329. LESOBL(8)='ALFA'
  330. LESOBL(9)='BETA'
  331. LESOBL(10)='K '
  332. LESOBL(11)='H '
  333. *
  334. NBTYPE=1
  335. SEGINI NOTYPE
  336. MOTYPE=NOTYPE
  337. TYPE(1)='REAL*8'
  338. ELSE IF (MAPL.EQ.4) THEN
  339. NBROBL=4
  340. SEGINI NOMID
  341. MOMATR=NOMID
  342. LESOBL(1)='YOUN'
  343. LESOBL(2)='NU '
  344. LESOBL(3)='SIGY'
  345. LESOBL(4)='H '
  346. *
  347. NBTYPE=1
  348. SEGINI NOTYPE
  349. MOTYPE=NOTYPE
  350. TYPE(1)='REAL*8'
  351. ELSE IF (MAPL.EQ.5) THEN
  352. NBROBL=3
  353. SEGINI NOMID
  354. MOMATR=NOMID
  355. LESOBL(1)='YOUN'
  356. LESOBL(2)='NU '
  357. LESOBL(3)='TRAC'
  358. *
  359. NBTYPE=3
  360. SEGINI NOTYPE
  361. MOTYPE=NOTYPE
  362. TYPE(1)='REAL*8'
  363. TYPE(2)='REAL*8'
  364. TYPE(3)='POINTEUREVOLUTIO'
  365. ELSE IF (MAPL.EQ.26) THEN
  366. NBROBL=3
  367. SEGINI NOMID
  368. MOMATR=NOMID
  369. LESOBL(1)='YOUN'
  370. LESOBL(2)='NU '
  371. LESOBL(3)='DC '
  372. *
  373. NBTYPE=1
  374. SEGINI NOTYPE
  375. MOTYPE=NOTYPE
  376. TYPE(1)='REAL*8'
  377. ELSE IF (MAPL.EQ.38) THEN
  378. * pour le modele de gurson l'option est indisponible
  379. CALL ERREUR (251)
  380. GOTO 9990
  381. *
  382. ELSE IF (MAPL.EQ.43) THEN
  383. * modele visco-plastique parfait
  384. NBROBL=5
  385. SEGINI NOMID
  386. MOMATR=NOMID
  387. LESOBL(1)='YOUN'
  388. LESOBL(2)='NU '
  389. LESOBL(3)='SIGY'
  390. LESOBL(4)='N '
  391. LESOBL(5)='K '
  392. *
  393. NBTYPE=1
  394. SEGINI NOTYPE
  395. MOTYPE=NOTYPE
  396. TYPE(1)='REAL*8'
  397. ELSE
  398. NBROBL=2
  399. SEGINI NOMID
  400. MOMATR=NOMID
  401. LESOBL(1)='YOUN'
  402. LESOBL(2)='NU '
  403. *
  404. NBTYPE=1
  405. SEGINI NOTYPE
  406. MOTYPE=NOTYPE
  407. TYPE(1)='REAL*8'
  408. ENDIF
  409. ELSE
  410. MOTERR(1:8)=NOMAT(MATE)
  411. MOTERR(9:12)=NOMAC(MAPL)
  412. MOTERR(13:20)=NOMFR(MFR)
  413. INTERR(1)=IFOUR
  414. CALL ERREUR(328)
  415. GOTO 9990
  416. ENDIF
  417. *
  418. CALL KOMCHA(IPCHE3,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  419. SEGSUP NOTYPE
  420. IF (IERR.NE.0) GOTO 9990
  421. NMATR=NBROBL
  422. NMATF=NBRFAC
  423. NMATT=NMATR+NMATF
  424. IF(ISUPMA.EQ.1)THEN
  425. CALL VALCHE(IVAMAT,NMATT,IPMIN1,IPPORE,MOMATR,MELE)
  426. IF(IERR.NE.0)THEN
  427. ISUPMA=0
  428. GOTO 9990
  429. ENDIF
  430. ENDIF
  431. *
  432. NCXMAT=NMATT
  433. IF(MAPL.EQ.3) NCXMAT=NMATT+7
  434. *
  435. * Traitement des champs de caracteristiques
  436. *
  437. MOCARA = 0
  438. NBROBL = 0
  439. NBRFAC = 0
  440. IVECT = 0
  441. *
  442. * Cas des coques
  443. *
  444. IF (MFR.EQ.3) THEN
  445. IF(IFOCHE.GE.-2.OR.IFOCHE.LE.2) THEN
  446. NBROBL=2
  447. SEGINI NOMID
  448. MOCARA=NOMID
  449. LESOBL(1)='EPAI'
  450. LESOBL(2)='CALF'
  451. *
  452. NBTYPE=1
  453. SEGINI NOTYPE
  454. MOTYPE=NOTYPE
  455. TYPE(1)='REAL*8'
  456. ENDIF
  457. ENDIF
  458. *
  459. NCARA=NBROBL
  460. NCARF=NBRFAC
  461. NCART=NCARA+NCARF
  462. IF (MOCARA.NE.0) THEN
  463. CALL KOMCHA(IPCHE3,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,IVACAR)
  464. SEGSUP,NOTYPE
  465. IF (IERR.NE.0) GOTO 9990
  466. *
  467. IF(ISUPMA.EQ.1)THEN
  468. CALL VALCHE(IVACAR,NCART,IPMIN1,IPPORE,MOCARA,MELE)
  469. IF(IERR.NE.0)THEN
  470. ISUPMA=0
  471. GOTO 9990
  472. ENDIF
  473. ENDIF
  474. SEGDES NOMID
  475. ENDIF
  476. *
  477. * Recherche de la taille des MELVALs a allouer
  478. *
  479. N2PTEL=NBG
  480. N2EL=NBELEM
  481. NEL=N2EL
  482. NBPTEL=N2PTEL
  483. *
  484. N1PTEL=0
  485. N1EL=0
  486. SEGINI MELVAL
  487. IVAHOO=MELVAL
  488. IELVAL(1)=MELVAL
  489. *
  490. * On met la courbe de traction a zero
  491. *
  492. SEGINI WRK1
  493. CALL ZDANUL(TRAC,LTRAC)
  494. *
  495. * DANS LE CAS DE COQUES INTEGREES ,ON LES TRAITE COMMME LE
  496. * MASSIF CONTRAINTE PLANE
  497. *
  498. IF(NPINT.NE.0)THEN
  499. IF(MELE.EQ.28)THEN
  500. IFOURB=-2
  501. MFR1=1
  502. ENDIF
  503. ELSE
  504. MFR1=MFR
  505. IFOURB=IFOUR
  506. ENDIF
  507. *
  508. * En cas de materiau endommageable
  509. *
  510. IF (MAPL.EQ.26.OR.MAPL.EQ.29) GOTO 555
  511. *
  512. * MFR= MASS COQU RAYL POUT CISTR LIQU TUYA LISP
  513. GOTO(1000,66,3000,66,66,66,66,66,66,66,66,66,66,66,66,
  514. * TUFI RAMA RACO SURF ICQ
  515. & 66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,1000),MFR1
  516. 66 CONTINUE
  517. MOTERR(1:8)=NOMFR(MFR)
  518. CALL ERREUR(193)
  519. GOTO 9990
  520. *_______________________________________________________________________
  521. *
  522. * Formulation MASSIVE
  523. *_______________________________________________________________________
  524. *
  525. 1000 CONTINUE
  526. DO 1001 IB=1,NEL
  527. DO 1001 IGAU=1,NBPTEL
  528. *
  529. IF(MAPL.EQ.5) THEN
  530. MPTVAL=IVAMAT
  531. MELVAL=IVAL(1)
  532. IBMN=MIN(IB ,VELCHE(/2))
  533. IGMN=MIN(IGAU,VELCHE(/1))
  534. YYYY=VELCHE(IGMN,IBMN)
  535. *
  536. MELVAL=IVAL(3)
  537. IBMN=MIN(IB ,IELCHE(/2))
  538. IGMN=MIN(IGAU,IELCHE(/1))
  539. IMMM=IELCHE(IGMN,IBMN)
  540. *
  541. CALL COTRA1(IMMM,YYYY,LTRAC,TRAC,NTRAC,KERRE)
  542. IF(KERRE.NE.0) THEN
  543. KERIB=IB
  544. KERIG=IGAU
  545. ENDIF
  546. ENDIF
  547. *
  548. CALL DOHOT1(IVAMAT,NMATT,IVACON,NSTRS,IVARI,NVART,TRAC,
  549. & LTRAC,IGAU,IB,MATE,MAPL,XPREC,DTPS,
  550. & IFOURB,LHOOK,DDHOOK,IRTD)
  551. *
  552. IF(IRTD.EQ.-1) THEN
  553. KPE=-1
  554. KPEIB=IB
  555. KPEIG=IGAU
  556. ENDIF
  557. C
  558. JG=LHOO2
  559. SEGINI MLREEL
  560. MELVAL=IVAHOO
  561. IELCHE(IGAU,IB)=MLREEL
  562. KO=0
  563. DO 1005 IO=1,LHOOK
  564. DO 1005 JO=1,LHOOK
  565. KO=KO+1
  566. PROG(KO)=DDHOOK(IO,JO)
  567. 1005 CONTINUE
  568. C*// SEGDES MLREEL
  569. 1001 CONTINUE
  570. GOTO 510
  571. *_______________________________________________________________________
  572. *
  573. * Cas des coques minces
  574. *_______________________________________________________________________
  575. *
  576. 3000 CONTINUE
  577. DO 3001 IB=1,NEL
  578. DO 3001 IGAU=1,NBPTEL
  579. *
  580. IF(MAPL.EQ.5) THEN
  581. MPTVAL=IVAMAT
  582. *
  583. MELVAL=IVAL(1)
  584. IBMN=MIN(IB ,VELCHE(/2))
  585. IGMN=MIN(IGAU,VELCHE(/1))
  586. YYYY=VELCHE(IGMN,IBMN)
  587. *
  588. MELVAL=IVAL(3)
  589. IBMN=MIN(IB ,IELCHE(/2))
  590. IGMN=MIN(IGAU,IELCHE(/1))
  591. IMMM=IELCHE(IGMN,IBMN)
  592. *
  593. CALL COTRA1(IMMM,YYYY,LTRAC,TRAC,NTRAC,KERRE)
  594. IF(KERRE.NE.0) THEN
  595. KERIB=IB
  596. KERIG=IGAU
  597. ENDIF
  598. ENDIF
  599. *
  600. MPTVAL=IVACAR
  601. MELVAL=IVAL(1)
  602. IBMN=MIN(IB ,VELCHE(/2))
  603. IGMN=MIN(IGAU,VELCHE(/1))
  604. EPAIST=VELCHE(IGMN,IBMN)
  605. *
  606. MELVAL=IVAL(2)
  607. IBMN=MIN(IB ,VELCHE(/2))
  608. IGMN=MIN(IGAU,VELCHE(/1))
  609. ALPHA=VELCHE(IGMN,IBMN)
  610. *
  611. * DOHOT3 se chargera de convertir les efforts generalises (IVACON)
  612. * et les variables internes generalisees (IVARI) en contraintes et
  613. * variables internes "locales"
  614. *
  615. CALL DOHOT3(IVAMAT,NMATT,IVACON,NSTRS,IVARI,NVART,
  616. & TRAC,LTRAC,ALPHA,EPAIST,IGAU,IB,MATE,MAPL,
  617. & XPREC,DTPS,IFOURB,LHOOK,DDHOOK,IRTD)
  618. *
  619. IF(IRTD.EQ.-1) THEN
  620. KPE=-1
  621. KPEIB=IB
  622. KPEIG=IGAU
  623. ENDIF
  624. C
  625. JG=LHOO2
  626. SEGINI MLREEL
  627. MELVAL=IVAHOO
  628. IELCHE(IGAU,IB)=MLREEL
  629. KO=0
  630. DO 3014 IO=1,LHOOK
  631. DO 3014 JO=1,LHOOK
  632. KO=KO+1
  633. PROG(KO)=DDHOOK(IO,JO)
  634. 3014 CONTINUE
  635. C*// SEGDES MLREEL
  636. 3001 CONTINUE
  637. GOTO 510
  638. *_______________________________________________________________________
  639. *
  640. * Cas des materiaux endommageables
  641. *_______________________________________________________________________
  642. *
  643. 555 CONTINUE
  644. IF(MAPL.EQ.26) NMATT=NMATT+4
  645. NCXMAT=NMATT
  646. SEGINI MIDON1
  647. SEGINI MIDON2
  648. SEGINI MIDON3
  649. DO 2001 IB=1,NEL
  650. DO 2001 IGAU=1,NBPTEL
  651. *
  652. * On recupere les Cts du mat.,les var. int. et les carac.
  653. *
  654. MPTVAL=IVAMAT
  655. DO 2010 ICOMP=1,2
  656. MELVAL=IVAL(ICOMP)
  657. IBMN=MIN(IB ,VELCHE(/2))
  658. IGMN=MIN(IGAU,VELCHE(/1))
  659. XMAT(ICOMP)=VELCHE(IGMN,IBMN)
  660. 2010 CONTINUE
  661. C
  662. IF(MAPL.EQ.29) GOTO 2015
  663. C
  664. DO 2011 ICOMP=3,6
  665. XMAT(ICOMP)=0.D0
  666. 2011 CONTINUE
  667. MELVAL=IVAL(3)
  668. IBMN=MIN(IB ,VELCHE(/2))
  669. IGMN=MIN(IGAU,VELCHE(/1))
  670. XMAT(7)=VELCHE(IGMN,IBMN)
  671. *
  672. 2015 MPTVAL=IVARI
  673. DO 2020 ICOMP=1,NVART
  674. MELVAL=IVAL(ICOMP)
  675. IBMN=MIN(IB ,VELCHE(/2))
  676. IGMN=MIN(IGAU,VELCHE(/1))
  677. VAR(ICOMP)=VELCHE(IGMN,IBMN)
  678. 2020 CONTINUE
  679. *
  680. IF(MOCARA.NE.0) THEN
  681. MPTVAL=IVACAR
  682. DO 2030 ICOMP=1,NCART
  683. MELVAL=IVAL(ICOMP)
  684. IBMN=MIN(IB ,VELCHE(/2))
  685. IGMN=MIN(IGAU,VELCHE(/1))
  686. XCAR(ICOMP)=VELCHE(IGMN,IBMN)
  687. 2030 CONTINUE
  688. ENDIF
  689. *
  690. * Selon le modele de materiau endommageable
  691. *
  692. ZERO=0.D0
  693. IF (MAPL.EQ.26) CALL ELAST1(1,IFOURB,VAR,NVART,XMAT,NCXMAT,
  694. &ZERO,ZERO,XCAR,NCART,MFR1,NSTRS,DDHOOK,DDHOMU,KERRE,-1,0)
  695. IF (MAPL.EQ.29) CALL ELAST1(1,IFOURB,VAR,NVART,XMAT,NCXMAT,
  696. &ZERO,ZERO,XCAR,NCART,MFR1,NSTRS,DDHOOK,DDHOMU,KERRE,-2,0)
  697. IF (KERRE.NE.0) GOTO 66
  698. *
  699. *
  700. JG=LHOO2
  701. SEGINI MLREEL
  702. MELVAL=IVAHOO
  703. IELCHE(IGAU,IB)=MLREEL
  704. KO=0
  705. IF(NPINT.NE.0.AND.MFR.EQ.3)THEN
  706. DDHOOK(1,3)=DDHOOK(1,4)
  707. DDHOOK(2,3)=DDHOOK(2,4)
  708. DDHOOK(3,1)=DDHOOK(1,3)
  709. DDHOOK(3,2)=DDHOOK(2,3)
  710. DDHOOK(3,3)=DDHOOK(4,4)
  711. DO 2041 IO=1,LHOOK/2
  712. IO1=LHOOK*(IO-1)
  713. IO2=LHOOK*(2+IO)
  714. DO 2041 JO=1,LHOOK/2
  715. JO1=IO1+JO
  716. JO2=IO2+JO
  717. PROG(JO1)=DDHOOK(IO,JO)
  718. PROG(JO2+3)=DDHOOK(IO,JO)
  719. 2041 CONTINUE
  720. ELSE
  721. DO 2040 IO=1,LHOOK
  722. DO 2040 JO=1,LHOOK
  723. KO=KO+1
  724. PROG(KO)=DDHOOK(IO,JO)
  725. 2040 CONTINUE
  726. ENDIF
  727. C*// SEGDES MLREEL
  728. 2001 CONTINUE
  729. *
  730. SEGSUP MIDON1
  731. SEGSUP MIDON2
  732. SEGSUP MIDON3
  733. IF(MAPL.EQ.26) NMATT=NMATT-4
  734.  
  735. GOTO 510
  736. *____________________________________________________________________*
  737. * *
  738. * DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS *
  739. *____________________________________________________________________*
  740. * *
  741. 510 CONTINUE
  742. *
  743. IF(MAPL.EQ.26.OR.MAPL.EQ.29) GOTO 110
  744. *
  745. * ERREUR le materiau n'est pas encore implente pour la
  746. * formulation MFR et l'option IFOUR
  747. *
  748. IF(IRTD.EQ.0) THEN
  749. MOTERR(1:8)=NOMAT(MATE)
  750. MOTERR(9:12)=NOMAC(MAPL)
  751. MOTERR(13:20)=NOMFR(MFR)
  752. INTERR(1)=IFOUR
  753. CALL ERREUR(328)
  754. GOTO 9990
  755. ENDIF
  756. *
  757. * Contraintes en dehors de la courbe de traction
  758. *
  759. IF(KPE.EQ.-1) THEN
  760. INTERR(1)=KPEIB
  761. INTERR(2)=KPEIG
  762. MOTERR(1:4)=NOMTP(MELE)
  763. CALL ERREUR(275)
  764. GOTO 9990
  765. ENDIF
  766. *
  767. * Probleme courbe de traction
  768. *
  769. IF(KERRE.NE.0) THEN
  770. INTERR(1)=KERIB
  771. INTERR(2)=KERIG
  772. MOTERR(1:4)=NOMTP(MELE)
  773. CALL ERREUR(KERRE)
  774. GOTO 9990
  775. ENDIF
  776. *
  777. 110 CONTINUE
  778. SEGDES MCHAML
  779. IF (IVAHOO.NE.0) THEN
  780. MELVAL=IVAHOO
  781. SEGDES MELVAL
  782. ENDIF
  783. *
  784. IF (ISUPMA.EQ.1) THEN
  785. CALL DTMVAL(IVAMAT,3)
  786. ELSE
  787. CALL DTMVAL(IVAMAT,1)
  788. ENDIF
  789. NOMID=MOMATR
  790. SEGSUP,NOMID
  791. *
  792. IF (ISUPMA.EQ.1) THEN
  793. CALL DTMVAL(IVACAR,3)
  794. ELSE
  795. CALL DTMVAL(IVACAR,1)
  796. ENDIF
  797. NOMID=MOCARA
  798. IF (MOCARA.NE.0) SEGSUP,NOMID
  799. *
  800. IF (ISUPVA.EQ.1) THEN
  801. CALL DTMVAL(IVARI,3)
  802. ELSE
  803. CALL DTMVAL(IVARI,1)
  804. ENDIF
  805. NOMID=MOVARI
  806. IF (lsupva) SEGSUP,NOMID
  807. *
  808. IF (ISUPCO.EQ.1) THEN
  809. CALL DTMVAL(IVACON,3)
  810. ELSE
  811. CALL DTMVAL(IVACON,1)
  812. ENDIF
  813. NOMID=MOCONT
  814. IF (lsupco) SEGSUP,NOMID
  815. *
  816. SEGDES,MINTE
  817. SEGDES IMODEL
  818. C*// SEGDES MELEME
  819. SEGSUP WRK1
  820. 100 CONTINUE
  821. IRET = 1
  822. SEGDES MMODEL,MCHELM
  823. RETURN
  824. *
  825. 9990 CONTINUE
  826. *_______________________________________________________________________
  827. *
  828. * ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  829. *_______________________________________________________________________
  830. *
  831. IRET = 0
  832. *
  833. IF (ISUPMA.EQ.1) THEN
  834. CALL DTMVAL(IVAMAT,3)
  835. ELSE
  836. CALL DTMVAL(IVAMAT,1)
  837. ENDIF
  838. NOMID=MOMATR
  839. SEGSUP,NOMID
  840. *
  841. IF (ISUPMA.EQ.1) THEN
  842. CALL DTMVAL(IVACAR,3)
  843. ELSE
  844. CALL DTMVAL(IVACAR,1)
  845. ENDIF
  846. NOMID=MOCARA
  847. IF (MOCARA.NE.0) SEGSUP,NOMID
  848. *
  849. IF (ISUPVA.EQ.1) THEN
  850. CALL DTMVAL(IVARI,3)
  851. ELSE
  852. CALL DTMVAL(IVARI,1)
  853. ENDIF
  854. NOMID=MOVARI
  855. IF (lsupva.AND.MOVARI.NE.0) SEGSUP,NOMID
  856. *
  857. IF (ISUPCO.EQ.1) THEN
  858. CALL DTMVAL(IVACON,3)
  859. ELSE
  860. CALL DTMVAL(IVACON,1)
  861. ENDIF
  862. NOMID=MOCONT
  863. IF (lsupco.AND.MOCONT.NE.0) SEGSUP,NOMID
  864. *
  865. IF (IVAHOO.NE.0) THEN
  866. MELVAL=IVAHOO
  867. SEGSUP MELVAL
  868. ENDIF
  869. IF (WRK1.NE.0) SEGSUP WRK1
  870. SEGDES,MINTE
  871. SEGDES MELEME
  872. SEGDES IMODEL
  873. SEGSUP MCHAML
  874. *
  875. SEGDES MMODEL
  876. SEGSUP MCHELM
  877.  
  878. RETURN
  879. END
  880.  
  881.  
  882.  
  883.  
  884.  
  885.  

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