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

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