Télécharger coml6.eso

Retour à la liste

Numérotation des lignes :

  1. C COML6 SOURCE BP208322 17/03/01 21:16:19 9325
  2.  
  3. SUBROUTINE COML6(iqmod,ipcon,ipinf,indeso,insupp,itruli, IRETOU)
  4.  
  5. *--------------------------------------------------------------------
  6. * coml6 :
  7. * boucle elements et point d integration
  8. * pretraite les caracteristiques et les donnees suivant
  9. * le modele, passe a la loi locale, signale les erreurs
  10. * d integration, prepare les resultats
  11. *----------------------------------------------------------------
  12.  
  13. IMPLICIT INTEGER(I-N)
  14. IMPLICIT REAL*8(A-H,O-Z)
  15.  
  16. -INC CCOPTIO
  17. -INC CCGEOME
  18. -INC CCHAMP
  19.  
  20. -INC SMCHAML
  21. -INC SMELEME
  22. -INC SMCOORD
  23. -INC SMMODEL
  24. -INC SMINTE
  25. * segment deroulant le mcheml
  26. -INC DECHE
  27. SEGMENT INFO
  28. INTEGER INFELL(16)
  29. ENDSEGMENT
  30. *
  31. SEGMENT WRK2
  32. REAL*8 TRAC(LTRAC)
  33. ENDSEGMENT
  34. *
  35. SEGMENT MWRKXE
  36. REAL*8 XEL(3,NBNN)
  37. ENDSEGMENT
  38. *
  39. SEGMENT WRK3
  40. REAL*8 WORK(LW),WORK2(LW2bi)
  41. ENDSEGMENT
  42. *
  43. SEGMENT WRK6
  44. REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS)
  45. REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS)
  46. REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS)
  47. ENDSEGMENT
  48. *
  49. SEGMENT WRK7
  50. REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
  51. ENDSEGMENT
  52. *
  53. SEGMENT WRK8
  54. REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
  55. REAL*8 DDINVp(NSTRS,NSTRS)
  56. ENDSEGMENT
  57. *
  58. SEGMENT WRK9
  59. REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
  60. REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
  61. REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
  62. REAL*8 SIGY(NSIGY)
  63. INTEGER NKX(NNKX)
  64. ENDSEGMENT
  65. *
  66. SEGMENT WRK91
  67. REAL*8 YOG1(NYOG1),YNU1(NYNU1),YALFT1(NYALFT1),YSMAX1(NYSMAX1)
  68. REAL*8 YN1(NYN1),YM1(NYM1),YKK1(NYKK1),YALF2(NYALF2)
  69. REAL*8 YBET2(NYBET2),YR1(NYR1),YA1(NYA1),YQ1(NYQ1),YRHO1(NYRHO1)
  70. REAL*8 SIGY1(NSIGY1)
  71. ENDSEGMENT
  72. *
  73. SEGMENT WR10
  74. INTEGER IABLO1(NTABO1)
  75. REAL*8 TABLO2(NTABO2)
  76. ENDSEGMENT
  77. *
  78. SEGMENT WR11
  79. INTEGER IABLO3(NTABO3)
  80. REAL*8 TABLO4(NTABO4)
  81. ENDSEGMENT
  82. *
  83. SEGMENT WRK12
  84. real*8 bbet1,bbet2,bbet3,bbet4,bbet5,bbet6,bbet7,bbet8,bbet9
  85. real*8 bbet10,bbet11,bbet12,bbet13,bbet14,bbet15,bbet16,bbet17
  86. real*8 bbet18,bbet19,bbet20,bbet21,bbet22,bbet23,bbet24,bbet25
  87. real*8 bbet26,bbet27,bbet28,bbet29,bbet30,bbet31,bbet32,bbet33
  88. real*8 bbet34,bbet35,bbet36,bbet37,bbet38,bbet39,bbet40,bbet41
  89. real*8 bbet42,bbet43,bbet44,bbet45,bbet46,bbet47,bbet48,bbet49
  90. real*8 bbet50,bbet51,bbet52,bbet53,bbet54,bbet55
  91. integer ibet1,ibet2,ibet3,ibet4,ibet5,ibet6,ibet7,ibet8
  92. integer ibet9,ibet10,ibet11,ibet12,ibet13,ibet14,ibet15,ibet16
  93. ENDSEGMENT
  94. segment wrkgur
  95. real*8 wgur1,wgur2,wgur3,wgur4,wgur5,wgur6,wgur7
  96. real*8 wgur8,wgur9,wgur10,wgur11,wgur12(6)
  97. real*8 wgur13(7), wgur14
  98. real*8 wgur15,wgur16,wgur17
  99. endsegment
  100. C
  101. C Segment de travail pour la loi 'NON_LINEAIRE' 'UTILISATEUR' appelant
  102. C l'integrateur externe specifique UMAT
  103. C
  104. SEGMENT WKUMAT
  105. C Entrees/sorties de la routine UMAT
  106. REAL*8 DDSDDE(NTENS,NTENS), SSE, SPD, SCD,
  107. & RPL, DDSDDT(NTENS), DRPLDE(NTENS), DRPLDT,
  108. & TIME(2), DTIME, TEMP, DTEMP, DPRED(NPRED),
  109. & DROT(3,3), PNEWDT, DFGRD0(3,3), DFGRD1(3,3)
  110. CHARACTER*16 CMNAME
  111. INTEGER NDI, NSHR, NSTATV, NPROPS,
  112. & LAYER, KSPT, KSTEP, KINC
  113. C Variables de travail
  114. LOGICAL LTEMP, LPRED, LVARI, LDFGRD
  115. INTEGER NSIG0, NPARE0, NGRAD0
  116. ENDSEGMENT
  117. C
  118. C Segment de travail pour les lois 'VISCO_EXTERNE'
  119. C
  120. SEGMENT WCREEP
  121. C Entrees/sorties constantes de la routine CREEP
  122. REAL*8 SERD
  123. CHARACTER*16 CMNAMC
  124. INTEGER LEXIMP, NSTTVC, LAYERC, KSPTC
  125. C Entrees/sorties de la routine CREEP pouvant varier
  126. REAL*8 STV(NSTV), STV1(NSTV), STVP1(NSTV),
  127. & STVP2(NSTV), STV12(NSTV), STVP3(NSTV),
  128. & STVP4(NSTV), STV13(NSTV), STVF(NSTV),
  129. & TMP12, TMP, TMP32,
  130. & DTMP12, DTMP,
  131. & PRD12(NPRD), PRD(NPRD), PRD32(NPRD),
  132. & DPRD12(NPRD), DPRD(NPRD)
  133. INTEGER KSTEPC
  134. C Autres indicateurs et variables de travail
  135. LOGICAL LTMP, LPRD, LSTV
  136. INTEGER IVIEX, NPAREC
  137. REAL*8 dTMPdt, dPRDdt(NPRD)
  138. ENDSEGMENT
  139.  
  140. * Segment ECOU: sert de fourre-tout pour les tableaux
  141. *
  142. SEGMENT ECOU
  143. REAL*8 ecow00,ecow0,
  144. 1 ecow1,ecow2,ecow3(6),ecow4(9),ecow5(6),
  145. 2 ecow6(12),ecow7(6),ecow8(6),ecow9(6),ecow10(6),ecow11(6),
  146. 2 ecow12(6),
  147. 1 ecow13(6),ecow14(6),ecow15(12),ecow16(3),
  148. 2 ecow17(6),ecow18(6),ecow19,ecow20
  149. ENDSEGMENT
  150. *
  151. * Segment NECOU utilisé dans ECOINC
  152. *
  153. SEGMENT NECOU
  154. INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  155. . ITYP,IFOURB,IFLUAG,
  156. . ICINE,ITHER,IFLUPL,ICYCL,IBI,
  157. . JFLUAG,KFLUAG,LFLUAG,
  158. . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
  159. ENDSEGMENT
  160. *
  161. * Segment IECOU: sert de fourre-tout pour les initialisations
  162. * d'entiers
  163. *
  164. SEGMENT IECOU
  165. INTEGER NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,NYALF1,
  166. . NYBET1,NYR,NYA,NYRHO,NSIGY,NNKX,NYKX,IND,NSOM,NINV,
  167. . NINCMA,NCOMP,JELEM,LEGAUS,INAT,NCXMAT,LTRAC,MFRBI,
  168. . IELE,NHRM,NBNNBI,NBELMB,ICARA,LW2BI,NDEF,NSTRSS,
  169. . MFR1,NBGMAT,NELMAT,MSOUPA,NUMAT1,LENDO,NBBB,NNVARI,
  170. . KERR1,MELEMB,NYOG1,NYNU1,NYALFT1,NYSMAX1,NYN1,NYM1,
  171. . NYKK1,NYALF2,NYBET2,NYR1,NYA1,NYQ1,NYRHO1,NSIGY1
  172. ENDSEGMENT
  173. *
  174. * Segment XECOU: sert de fourre-tout pour les initialisations
  175. * de réels
  176. *
  177. SEGMENT XECOU
  178. REAL*8 DTOPTI,TSOM,TCAR,DTT,DT,TREFA,TEMP00
  179. ENDSEGMENT
  180.  
  181. character*16 modemo
  182. LOGICAL dimped, b_moda2
  183. *
  184. * Liste des formulations SIMPLES (cf. MODELI.eso et NOMATE.eso)
  185. *
  186. PARAMETER (MFORMU=17)
  187. CHARACTER*16 LISFOR(MFORMU)
  188. DATA LISFOR /
  189. & 'THERMIQUE ','MECANIQUE ','LIQUIDE ',
  190. & 'CONVECTION ','POREUX ','DARCY ',
  191. & 'FROTTEMENT ','RAYONNEMENT ','MAGNETODYNAMIQUE',
  192. & 'NAVIER_STOKES ','MELANGE ','EULER ',
  193. & 'FISSURE ','LIAISON ','THERMOHYDRIQUE ',
  194. & 'ELECTROSTATIQUE ','DIFFUSION '
  195. & /
  196. *
  197. wrk6 = 0
  198. wrk8 = 0
  199. wr10 = 0
  200. wr11 = 0
  201. wrk12 = 0
  202. wrkgur=0
  203. wkumat = 0
  204. wcreep = 0
  205. *
  206. c wrk53 reste ouvert en ecriture
  207. SEGINI,wrk53
  208. iwrk53 = wrk53
  209. *
  210. ecou=0
  211. iecou=0
  212. necou=0
  213. xecou=0
  214. SEGINI,ecou,iecou,necou,xecou
  215. * write(ioimp,*) ' coml6 ecou ie ne xe',ecou,iecou,necou,xecou
  216.  
  217. KERRE=0
  218. KERR1=0
  219. c
  220. c moterr(1:6) = 'COML6 '
  221. c moterr(7:15) = 'IMODEL'
  222. c interr(1) = iqmod
  223. c call erreur(-329)
  224. *-------------------------------------------
  225. imodel = iqmod
  226. segact imodel*nomod
  227. *
  228. MELE=NEFMOD
  229. MELEME=IMAMOD
  230. melemb=meleme
  231. ipmail = imamod
  232. CONM = CONMOD
  233. segact meleme*nomod
  234. NBNNbi=NUM(/1)
  235. NBELMb=NUM(/2)
  236. nbnn2=nbnnbi
  237. nbelem2=nbelmb
  238. nbnn=nbnnbi
  239. nbelem=nbelmb
  240. c
  241. c coque integree ou pas ?
  242. c
  243. IF(INFMOD(/1).NE.0)THEN
  244. NPINT=INFMOD(1)
  245. ELSE
  246. NPINT=0
  247. ENDIF
  248. c
  249. NFOR=FORMOD(/2)
  250. NMAT=MATMOD(/2)
  251. c
  252. c Determination de la formulation du modele :
  253. c
  254. lformu = 0
  255. IF (NFOR.EQ.1) THEN
  256. CALL PLACE(LISFOR,MFORMU,lformu,FORMOD(1))
  257. ENDIF
  258. * write(ioimp,*) 'formulation :',lformu,NFOR,FORMOD(1)
  259. if (lformu.eq.0) then
  260. write(ioimp,*) ' Arret dans coml6 : formulation non prevue ici'
  261. call erreur(5)
  262. return
  263. endif
  264. c
  265. c nature du materiau
  266. c
  267. CMATE = CMATEE
  268. MATE = IMATEE
  269. INPLAS = INATUU
  270. c
  271. dimped=.false.
  272. do jmot = 1,nmat
  273. if (matmod(jmot).eq.'IMPEDANCE') dimped = .true.
  274. enddo
  275. b_moda2 = cmate.EQ.'MODAL' .OR. cmate.EQ.'STATIQUE'
  276. if (dimped) then
  277. if (itypel.eq.1) mele = 45
  278. endif
  279. c____________________________________________________________________
  280. c
  281. c information sur l'element fini
  282. c____________________________________________________________________
  283. if(ipinf.ne.0) then
  284. INFO=IPINF
  285. c* segact info
  286. MFRbi =INFELL(13)
  287. NBG =INFELL(6)
  288. NBGS =INFELL(4)
  289. NSTRS=INFELL(16)
  290. LRE =INFELL(9)
  291. LHOOK=INFELL(10)
  292. c* IF (MELE.EQ.96) NBNO = INFELL(8)
  293. IPORE=INFELL(8)
  294. MINTE=INFELL(11)
  295. else
  296. MFRbi =INFELE(13)
  297. NBG =INFELE(6)
  298. NBGS =INFELE(4)
  299. NSTRS=INFELE(16)
  300. LRE =INFELE(9)
  301. LHOOK=INFELE(10)
  302. c* IF (MELE.EQ.96) NBNO = INFELE(8)
  303. IPORE=INFELE(8)
  304. MINTE=INFMOD(2+insupp)
  305. endif
  306. *
  307. MFR=MFRbi
  308. nstrss=nstrs
  309. if (CMATEE.EQ.'IMPELAST'.and.inatuu.ne.161) LHOOK = 6
  310. * On active une fois pour toutes le segment MINTE :
  311. IPMINT = MINTE
  312. IF (IPMINT.GT.0) SEGACT,MINTE
  313. *
  314. IF (MFRbi.EQ.3.AND.NPINT.NE.0) LHOOK=4
  315. LHOO2=LHOOK*LHOOK
  316. *
  317. IF (MFRbi.EQ.33) THEN
  318. NBNO=IPORE
  319. IPPORE=NBNNbi
  320. ELSE
  321. NBNO=NBNNE(NUMGEO(MELE))
  322. IPPORE=0
  323. ENDIF
  324. *
  325. LW =200
  326. LW2bi =150
  327. LW2=150
  328. *-------------------------------------------------
  329. *
  330. NBPTEL=NBGS
  331. NEL=NBELMb
  332. *
  333. N1PTEL=NBPTEL
  334. N1EL=NEL
  335. N2PTEL=0
  336. N2EL=0
  337.  
  338. c pour les variables internes seules
  339. IF (MFRbi.EQ.7.OR.MFRbi.EQ.13) THEN
  340. IF (CMATE.EQ.'SECTION') THEN
  341. C* IF (MATE.EQ.11) THEN <- Test equivalent ?
  342. N2PTEL=NBPTEL
  343. N2EL=NEL
  344. ENDIF
  345. ENDIF
  346. *-------------------------------------------------
  347. * ouverture de tous les melval
  348. * creation wrk52 qui reste ouvert en ecriture
  349. *-------------------------------------------------
  350. CALL COMOUW(iqmod,ipcon,indeso,ipil,iwrk52,iwrk53,iretou,iwr522)
  351.  
  352. *-------------------------------------------------
  353. * complete wrk53
  354. *-------------------------------------------------
  355. wrk52 = iwrk52
  356. c segact wrk52
  357. nmatt = xmat(/1)
  358. NUMAT = nmatt
  359. * ncarr = xcarb(/1)
  360. * NUCAR = ncarr
  361. nvart = var0(/1)
  362. C-------------------------------------------------
  363. C Petits tests de compatibilite des donnees
  364. C pour les lois externes
  365. C-------------------------------------------------
  366. IF (INPLAS.LT.0) THEN
  367. NTURE0 = TURE0(/1)
  368. c IF (NTURE0.NE.0.AND.NTURE0.GT.1) THEN
  369. * write(ioimp,*) 'COML6 : test NTURE0 enleve',NTURE0
  370. c* CALL ERREUR(963)
  371. c* RETURN
  372. c ENDIF
  373. IF (INPLAS.EQ.-1) THEN
  374. NSIGM0 = SIG0(/1)
  375. NEPST0 = EPST0(/1)
  376. IF (NSIGM0.GT.0.AND.NEPST0.GT.0.AND.NSIGM0.NE.NEPST0) THEN
  377. CALL ERREUR(963)
  378. RETURN
  379. ENDIF
  380. ENDIF
  381. ENDIF
  382. *-------------------------------------------------
  383. * creation des deche en sortie
  384. *-------------------------------------------------
  385. CALL COMCRI(iqmod,ipcon,IPMINT,indeso,ipil,insupp,iwrk53,iretou)
  386. if (ierr.ne.0) return
  387. c liluc = ipil
  388.  
  389. * pas de calcul de caracteristiques pour le melange parallele
  390. C* if (formod(1).eq.'MELANGE'.and.cmate.eq.'PARALLEL') goto 1998
  391. if (lformu.eq.11) then
  392. if (cmate.eq.'PARALLEL') goto 1998
  393. endif
  394.  
  395. *-------------------------------------------------
  396. * verification du type des champs
  397. *-------------------------------------------------
  398. CALL COMTRI(iqmod,ipil,wrk53)
  399. if (ierr.ne.0) return
  400. c
  401. *-------------------------------------------------
  402. c Initialisations de variables
  403. *-------------------------------------------------
  404. c - mise à zéro des variables du commun NECOU si besoin
  405. c - modèles viscoplastiques:
  406. c . on récupère le pas de temps
  407. c . on récupère le nombre maximal de sous-pas
  408. c . on met IND=1
  409. c - initialisation des dimensions des tableaux des segments
  410. c Sorties: en plus du commun NECOU, on range les autres données
  411. c initialisées dans les COMMON IECOU et XECOU
  412. CALL COMDEF(iwrk53,necou,iecou,xecou)
  413. IF (KERRE.EQ.999) RETURN
  414. c
  415. * write(ioimp,*) ' coml6 ,cmate,mfrbi,nbno,mele,npint'
  416. * & ,cmate,mfrbi,nbno,mele,npint
  417.  
  418. IPTR1 = 0
  419. IF (MFRbi.EQ. 1 .OR. MFRbi.EQ.31 .OR. MFRbi.EQ.33 .OR.
  420. & MFRbi.EQ.71 .OR. MFRbi.EQ.73) THEN
  421. IF (CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  422. 1 CMATE.EQ.'UNIDIREC') THEN
  423. C* IF (MATE.EQ.2 .OR. MATE.EQ.3 .OR. MATE.EQ.4) THEN <- Test equivalent ?
  424. mele1 = MELE
  425. npint1 = NPINT
  426. nbno1 = NBNO
  427. ielei=iele
  428. CALL RESHPT(1,nbno1,IELEi,mele1,npint1,IPTR1,IRT1)
  429. if (ierr.ne.0) return
  430. MINTE2=IPTR1
  431. SEGACT MINTE2
  432. ENDIF
  433. ENDIF
  434. *
  435. * initialisation des segments de travail
  436. *
  437. SEGINI WRK2,WRK3
  438.  
  439. NBNN = nbnn2
  440. SEGINI,MWRKXE
  441.  
  442. IF (LOGVIS) SEGINI WRK8
  443. IF(INPLAS.EQ.26)THEN
  444. SEGINI WRK6
  445. ENDIF
  446. c
  447. segini wrk54
  448. iwrk54 = wrk54
  449. c ouverture du segment wrk12 ne sert que pour le modele beinsa inplas=66
  450. if(inplas.eq.66) segini wrk12
  451. C ouverture de wrkgur pour modele de gurson inplas=38
  452. if(inplas.eq.38) segini wrkgur
  453.  
  454. C Pour les modeles autres que non lineaires externes :
  455. C pas besoin des coordonnees du point d'integration courant
  456. c Pas besoin de la longueur caracteristique de l'element courant
  457. C On les met a zero une fois pour toutes
  458. COORGA(1)=0.0D0
  459. COORGA(2)=0.0D0
  460. COORGA(3)=0.0D0
  461. LCARAC=0.0D0
  462.  
  463. C Objets de travail pour une loi non lineaire externe
  464. IF (INPLAS.LT.0) THEN
  465. IF (INPLAS.EQ.-1) THEN
  466. NTENS=SIG0(/1)
  467. NPRED=PAREX0(/1)
  468. SEGINI,WKUMAT
  469. IFORB=IFOURB
  470. CALL WKUMA0 ( iqmod, iwrk52, wkumat, IFORB )
  471. C* ELSE IF (INPLAS.EQ.-2) THEN
  472. ELSE
  473. NSTV=VAR0(/1)-4
  474. IF (NSTV.EQ.0) NSTV=1
  475. NPRD=PAREX0(/1)
  476. SEGINI,WCREEP
  477. CALL WCREE0 ( iqmod, iwrk52, wcreep )
  478. ENDIF
  479. C*TMP Deb On met dans wrk53.jecher le pointeur de la fonction externe
  480. C*TMP Voir plus tard pour affiner via segment wkumat/wcreep...
  481. wrk53.jecher = 0
  482. nobmod = ivamod(/1)
  483. if (nobmod.gt.0) then
  484. noblib = 0
  485. CALL PLACE(tymode,nobmod,noblib,'LMEEXT ')
  486. if (noblib.ne.0) then
  487. wrk53.jecher = ivamod(noblib)
  488. endif
  489. endif
  490. C*TMP Fin
  491. ENDIF
  492. *
  493. * write(6,*)'coml6 ,nel,nbptel,inplas,mfrbi,cmate,mate,ifour,mele'
  494. * write(6,*)'coml6 ',nel,nbptel,inplas,mfrbi,cmate,mate,ifour,mele
  495. * boucles
  496. ncourb=0
  497. segini wrk7
  498. NYOG=0
  499. NYNU=0
  500. NYALFA=0
  501. NYSMAX=0
  502. NYN=0
  503. NYM=0
  504. NYKK=0
  505. NYALF1=0
  506. NYBET1=0
  507. NYR=0
  508. NYA=0
  509. NYKX=0
  510. NYRHO=0
  511. NSIGY=0
  512. NNKX=0
  513. segini wrk9
  514. NYOG1=0
  515. NYNU1=0
  516. NYALFT1=0
  517. NYSMAX1=0
  518. NYN1=0
  519. NYM1=0
  520. NYKK1=0
  521. NYALF2=0
  522. NYBET2=0
  523. NYR1=0
  524. NYA1=0
  525. NYQ1=0
  526. NYRHO1=0
  527. NSIGY1=0
  528. segini wrk91
  529.  
  530. do 1000 ib=1,nel
  531.  
  532. * (MWRKXE) Recuperation des coordonnees des noeuds de l'element
  533. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XEL)
  534.  
  535. * (WRK54) calcul des axes locaux
  536. CALL COMROT(iwrk53,IB,IPTR1,MWRKXE,iwrk54)
  537. if (ierr.ne.0) return
  538.  
  539. * CALCUL DE LA LONGUEUR CARACTERISTIQUE DE L'éLéMENT COURANT
  540. * POUR MODèLE BETON URGC INSA
  541. IF ((INPLAS.GE.99.AND.INPLAS.LE.101).OR.
  542. 1 (INPLAS.GE.120.AND.INPLAS.LE.122)) THEN
  543. CALL LONGCA(IPMAIL,IB,BID(1))
  544. ENDIF
  545.  
  546. * Modeles non lineaires externes 'NON_LINEAIRE' 'UTILISATEUR' :
  547. * - Releve des coordonnees des noeuds de l'element courant,
  548. * - Calcul de la longueur caracteristique de l'element courant
  549. * - Releve de la matrice de passage DROT du repere local de l'element
  550. * fini massif au repere general du maillage
  551. IF (INPLAS.EQ.-1) THEN
  552. IF (IPTR1.NE.0) THEN
  553. DO 200 J=1,IDIM
  554. DO 200 I=1,IDIM
  555. DROT(I,J)=TXR(I,J)
  556. 200 CONTINUE
  557. ENDIF
  558. CALL LOCARA(IDIM,NBNN,XEL,LCARAC)
  559. ENDIF
  560.  
  561. DO 100 igau =1,nbptel
  562.  
  563. * -recuperation de valmat et de valcar
  564. * -on recupere les contraintes initiales
  565. * -on recupere les variables internes
  566. * -on recupere les deformations inelastiques initiales si besoin
  567. * -on recupere les increments de deformations totales
  568. * -on cherche la section de l'element ib
  569. * -prise en compte de l'epaisseur et de l'excentrement
  570. * dans le cas des coques minces avec ou sans cisaillement
  571. * transverse
  572. *
  573. * on recupere les constantes du materiau
  574. * calcul des contraintes effectives en milieu poreux
  575. *
  576. * --- remplissage de wrk52
  577. * on recupere les caracteristiques geometriques
  578. CALL COMVAL(iqmod,indeso,ipil,iwrk52,iwrk53,ib,igau,
  579. & necou,iecou,xecou,iwr522)
  580. if (ierr.ne.0) return
  581. *
  582. *---- quelques arrangements
  583. CALL COMARA(IQMOD,IWRK52,IWRK53,IWRK54,wrk2,wr10,ib,igau,
  584. & iretou,necou,iecou,xecou,itruli)
  585. if (ierr.ne.0) return
  586. if (iretou.ne.0) goto 1990
  587. * >>>>>>>>>> fin du traitement du materiau
  588. *
  589. C Pour les modeles non lineaires externes : calcul des coordonnees
  590. C du point d'integration courant
  591. IF (INPLAS.LT.0) THEN
  592. DO 101 IX=1,IDIM
  593. r_z = 0.0D0
  594. DO 102 INO=1,NBNN
  595. r_z = r_z +XEL(IX,INO)*SHPTOT(1,INO,IGAU)
  596. 102 CONTINUE
  597. COORGA(IX) = r_z
  598. 101 CONTINUE
  599. ENDIF
  600. *
  601. * lois au point d integration
  602. c
  603. c traitement du modele
  604. c
  605. c Branchement suivant la formulation :
  606. c
  607. GOTO (9999,9002,9999,9999,9002,9999,9999,9999,9999,9999,9011,9999,
  608. & 9999,9014,9999,9999,9017),lformu
  609.  
  610. 9999 CONTINUE
  611. c---- FORMULATION : THERMIQUE / LIQUIDE / CONVECTION /
  612. c DARCY / FROTTEMENT / RAYONNEMENT /
  613. c MAGNETODYNAMIQUE / NAVIER_STOKES /
  614. c EULER / FISSURE / THERMOHYDRIQUE /
  615. c ELECTROSTATIQUE / DIFFUSION
  616. * write(ioimp,*) 'Formulation non implementee'
  617. RETURN
  618. c
  619. c---- FORMULATION : MECANIQUE / POREUX
  620. 9002 CONTINUE
  621. IF (b_moda2.or.(dimped.and.inatuu.ge.161.and.inatuu.le.164)) THEN
  622. iforb=ifourb
  623. nbgmab=nbgmat
  624. nlmatb=nelmat
  625. xdt = dt
  626. CALL cmoda2(wrk52,wrk53,xdt,ib,igau,nbpgau,nbgmab,nlmatb,iforb)
  627. ifourb=iforb
  628. nbgmat=nbgmab
  629. nelmat=nlmatb
  630. ELSE
  631. jnppla=inplas+3
  632. * Cas VISCO_EXTERNE (inplas = -2) et UMAT (inplas = -1)
  633. GOTO( 8, 8,
  634. * inplas 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
  635. $ 7,7, 8, 7, 7, 7,111, 7,111, 8,111,111, 7,111, 8, 7,
  636. * 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
  637. $ 8, 7, 8, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8,
  638. * 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45
  639. $ 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 7, 7, 7,
  640. * 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
  641. $ 111, 8, 8, 8, 8, 8, 8, 7, 8, 8, 8, 8, 8, 8, 8,
  642. * 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75
  643. $ 7, 8, 7, 8, 8, 8, 8, 8, 8, 7, 8, 8, 8, 8, 8,
  644. * 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90
  645. $ 7, 7, 8, 8, 8,111, 7,111, 7, 7, 7, 7, 8, 8, 7,
  646. * 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105
  647. $ 8, 8, 8, 7, 7, 8, 8, 8, 7, 7, 7, 7, 7, 8, 7,
  648. * 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120
  649. $ 8, 7, 8,111,111, 7, 7, 7,111,111,111,111, 8, 8, 7,
  650. * 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135
  651. $ 7, 7,111,111, 8, 8, 8, 8, 8, 7, 8, 8, 8, 8, 8,
  652. * 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150
  653. $ 7, 7, 7, 7, 8, 8, 8, 8, 12, 12, 12, 8, 111,111, 8,
  654. * 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165
  655. $ 8, 8, 12, 12, 8, 8, 12, 12, 12, 12,12, 12, 12, 12, 12,
  656. * 166 167 168 169 170 171 172 173 174 175 176 177
  657. $ 12, 12, 12, 12, 12, 12, 12, 12, 8, 12, 12, 12
  658. $ )jnppla
  659. 111 continue
  660. * write(ioimp,*) ' stop dans coml6 : comportement pas prevu ici'
  661. * write(ioimp,*) ' inplas jnppla ',inplas,jnppla
  662. CALL erreur(5)
  663. return
  664. 7 continue
  665. * if(ib.eq.1.and.igau.eq.1) write(ioimp,*) 'appel coml7'
  666. CALL coml7(iqmod,iwrk52,iwrk53,iwrk54,ib,igau,
  667. & wrk2,mwrkxe,wrk3,wrk6,wrk7,wrk8,wrk9,wrk91,wr10,wr11,
  668. & iretou,wrk12,wrkgur,wkumat,wcreep,ecou,iecou,necou,xecou)
  669. go to 2000
  670. 8 continue
  671. * if(ib.eq.1.and.igau.eq.1) write(ioimp,*) ' appel coml8'
  672. CALL coml8(iqmod,iwrk52,iwrk53,iwrk54,ib,igau,
  673. & wrk2,mwrkxe,wrk3,wrk6,wrk7,wrk8,wrk9,wrk91,wr10,wr11,
  674. & iretou,wrk12,wrkgur,wkumat,wcreep,ecou,iecou,necou,xecou)
  675. go to 2000
  676. 12 continue
  677. C if(ib.eq.1.and.igau.eq.1) write(ioimp,*) ' appel coml12'
  678. CALL coml12(iqmod,iwrk52,iwrk53,iwrk54,ib,igau,
  679. & wrk2,mwrkxe,wrk3,wrk6,wrk7,wrk8,wrk9,wrk91,wr10,wr11,
  680. & iretou,wrk12,wrkgur,wkumat,wcreep,ecou,iecou,necou,xecou)
  681. go to 2000
  682. ENDIF
  683. GOTO 2000
  684.  
  685. c---- FORMULATION : MELANGE (microstructures)
  686. 9011 CONTINUE
  687. *
  688. IF (CMATE.EQ.'MGRAIN') THEN
  689. CALL mgrain(xmat0,ture0,xmatf,turef)
  690.  
  691. ELSE if (CMATE.EQ.'CEREM') then
  692. * constituer en cas de besoin les nuages d interpolation
  693. ipnua1 = int(xmat0(16))
  694. modemo = 'CEREMREFR'
  695. CALL copret(ipnua1,ilent1,modemo)
  696. if (ilent1.eq.0) then
  697. CALL chist(ipnua1,ilent1,iwrk52,modemo)
  698. if (ierr.ne.0) return
  699. call compre(ipnua1,ilent1,modemo)
  700. endif
  701. *
  702. modemo = 'CEREMCHAU'
  703. ipnua1 = int(xmat0(17))
  704. call copret(ipnua1,ilent2,modemo)
  705. if (ilent2.eq.0) then
  706. call chist(ipnua1,ilent2,iwrk52,modemo)
  707. if (ierr.ne.0) return
  708. call compre(ipnua1,ilent2,modemo)
  709. endif
  710. *
  711. call CRPHA3(iwrk52,iwrk53,ilent1,ilent2,IB,igau)
  712. *
  713. ELSE if (CMATE.EQ.'LEBLOND') then
  714. call clebl3(iwrk52,IB,igau)
  715. *
  716. ELSE if (CMATE.EQ.'ZTMAX') then
  717. call cztmax(iwrk52,iwrk53, ib,igau)
  718. *
  719. ELSE if (CMATE.EQ.'TMM_LMT2') then
  720. call t4m(iwrk52,iwrk53, ib,igau)
  721. *
  722. ENDIF
  723. GOTO 2000
  724.  
  725. c---- FORMULATION : LIAISON
  726. 9014 CONTINUE
  727. if (itruli.le.0) then
  728. write(ioimp,*) ' stop dans coml6 : itruli <= 0'
  729. call erreur(5)
  730. return
  731. endif
  732. if (mate.ge.23) then
  733. call coml11(iqmod,wrk52,wrk53,ib,igau,itruli,iretou)
  734. else
  735. call coml10(iqmod,wrk52,wrk53,ib,igau,itruli,iretou)
  736. endif
  737. GOTO 2000
  738.  
  739. c----- FORMULATION : DIFFUSION
  740. 9017 CONTINUE
  741. * write(ioimp,*) 'DIFFUSION : a faire !!!'
  742. CALL coml14(iqmod,iwrk52,iwrk53,ib,igau,iretou)
  743. GOTO 2000
  744.  
  745. * Erreurs
  746. *
  747. 2000 continue
  748. if (ierr.ne.0) return
  749. *
  750. * - problèmes de convergence
  751. *
  752. interr(3) = inplas
  753. CALL DEFER1(JNOID,KERR1,KERRE,LOGSUC)
  754. if (ierr.ne.0) return
  755. *
  756. * - autres problèmes
  757. *
  758. 1990 CONTINUE
  759. IF (kerre.NE.0) THEN
  760. jnplas = inplas
  761. jmfr = mfrbi
  762. jmele = mele
  763. jkerr1 = kerr1
  764. jkerre = kerre
  765. if (jnplas.LT.0) MOTERR(5:20) = wkumat.cmname(1:16)
  766. CALL DEFER2(JNPLAS,JMFR,JMELE,IB,IGAU, jkerr1,jkerre)
  767. if (ierr.ne.0) return
  768. ENDIF
  769. c
  770. c remplissage des melval contenant les contraintes a la fin
  771. * ( rearrangement pour milieu poreux ),
  772. c les variables internes finales
  773. c et les increments de deformations plastiques
  774. c stocke pas de temps optimal
  775. c
  776. CALL COMSOR(iqmod,ipil,iwrk52,iwrk53,iwrk54,ib,igau,iecou,xecou)
  777. if (ierr.ne.0) return
  778. c
  779. C-----------------------------------------------------------------------
  780. c fin de la boucle sur les points de gauss
  781. 100 continue
  782. C-----------------------------------------------------------------------
  783. c
  784. c special poutres et tuyaux sauf timoschenko
  785. c
  786. if (.not.dimped) then
  787. CALL COMPOU(IB,mwrkxe,ipil,iwrk53)
  788. if (ierr.ne.0) return
  789. endif
  790. C-----------------------------------------------------------------------
  791. c fin de la boucle sur les elements
  792. 1000 continue
  793. C-----------------------------------------------------------------------
  794. *
  795. C Desactivation de segments
  796. IF (IPMINT.GT.0) SEGDES,MINTE
  797. IF (IPTR1.NE.0) THEN
  798. C* IF (MFRbi.EQ. 1 .OR. MFRbi.EQ.31 .OR. MFRbi.EQ.33 .OR.
  799. C* & MFRbi.EQ.71 .OR. MFRbi.EQ.73) THEN
  800. C* IF (CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  801. C* 1 CMATE.EQ.'UNIDIREC') THEN
  802. C*C* IF (MATE.EQ.2 .OR. MATE.EQ.3 .OR. MATE.EQ.4) THEN <- Test equivalent ?
  803. SEGDES MINTE2
  804. C* ENDIF
  805. ENDIF
  806. c Destruction des segments de travail
  807. SEGSUP wrk7,wrk9,wrk91
  808. SEGSUP WRK2,WRK3
  809. SEGSUP MWRKXE
  810. IF (wrk6.NE.0) SEGSUP,WRK6
  811. IF (LOGVIS) SEGSUP,WRK8
  812. if (wr10.ne.0) segsup wr10
  813. if (wr11.ne.0) segsup wr11
  814. if (wrk12.ne.0) segsup wrk12
  815. if (wrkgur.ne.0) segsup wrkgur
  816. IF (wkumat.ne.0) SEGSUP,WKUMAT
  817. IF (wcreep.ne.0) SEGSUP,WCREEP
  818. segsup wrk54
  819. 1998 CONTINUE
  820. segsup wrk53
  821. segsup ecou,iecou,necou,xecou
  822. c Fermeture des melval & destruction des segments associes
  823. CALL COMFIN(ipil,iwrk52,iwr522)
  824.  
  825. return
  826. end
  827.  
  828.  
  829.  
  830.  
  831.  
  832.  
  833.  
  834.  
  835.  
  836.  
  837.  
  838.  
  839.  
  840.  
  841.  
  842.  

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