Télécharger cicsic.eso

Retour à la liste

Numérotation des lignes :

  1. C CICSIC SOURCE BP208322 17/03/01 21:15:35 9325
  2.  
  3. SUBROUTINE CICSIC(WRK52,WRK53,WRK54,WRK22,IB,IGAU,NVARI,NBPGAU
  4. & ,necou,iecou)
  5. C
  6. C variables en entree
  7. C
  8. C WRK0,KRK1,WRK5 pointeurs sur des segments de travail
  9. C
  10. C WRK0:
  11. C XMAT(NMATT): tableau composantes materiaux
  12. C
  13. C WRK1:
  14. C SIG0(NSTRS) : contraintes au debut du pas
  15. C VAR0(NVARI) : variables internes au debut du pas
  16. C DEPST(NSTRS): increment de deformation totale
  17. C
  18. C WRK22:
  19. C XXE: coordonnees de l'element en double precison
  20. C
  21. C WTRAV:
  22. C TXR: cosinus directeurs des axes locaux de l'element massif
  23. C
  24. C WRK5:
  25. C
  26. C NSTRS nombre de composantes dans les vecteurs des contraintes
  27. C et les vecteurs des deformations
  28. C
  29. C NVARI nombre de variables internes (doit etre egal a 3)
  30. C
  31. C NMATT nombre de constantes du materiau
  32. C
  33. C variables en sortie
  34. C
  35. C VARF variables internes finales dans WRK0
  36. C
  37. C SIGF contraintes finales dans WRK0
  38. C
  39. IMPLICIT INTEGER(I-N)
  40. IMPLICIT REAL*8(A-H,O-Z)
  41. C
  42. -INC CCOPTIO
  43. -INC CCREEL
  44. -INC DECHE
  45. *
  46. * Commun NECOU utilisé dans ECOINC
  47. *
  48. SEGMENT NECOU
  49. INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  50. . ITYP,IFOURB,IFLUAG,
  51. . ICINE,ITHER,IFLUPL,ICYCL,IBI,
  52. . JFLUAG,KFLUAG,LFLUAG,
  53. . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
  54. ENDSEGMENT
  55. *
  56. * Commun IECOU: sert de fourre-tout pour les initialisations
  57. * d'entiers
  58. *
  59. SEGMENT IECOU
  60. INTEGER NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,
  61. . NYALF1,NYBET1,NYR,NYA,NYRHO,NSIGY,NNKX,NYKX,IND,
  62. . NSOM,NINV,NINCMA,NCOMP,JELEM,LEGAUS,INAT,NCXMAT,
  63. . LTRAC,MFRbi,IELE,NHRM,NBNNBI,NBELMB,ICARA,
  64. . LW2bi,NDEF,NSTRSS,MFR1,NBGMAT,NELMAT,MSOUPA,
  65. . NUMAT1,LENDO,NBBB,NNVARI,KERR1,MELEME
  66. INTEGER icow45,icow46,icow47,icow48,icow49,icow50,
  67. . icow51,icow52,icow53,icow54,icow55,icow56
  68. . icow57,icow58
  69. ENDSEGMENT
  70. *
  71. SEGMENT WRK22
  72. REAL*8 XXE(3,NBNNbi)
  73. ENDSEGMENT
  74. *
  75. SEGMENT WRK6
  76. REAL*8 SIG0S(NSTRS),DEPSTS(NSTRS)
  77. END SEGMENT
  78.  
  79. INTEGER NSTRS1,NVARI
  80. INTEGER KCAS,IRTD,ISTRS
  81.  
  82. REAL*8 IDAUX(6,6)
  83. REAL*8 DOR1(3), DOR2(3), DOR3(3)
  84. REAL*8 MORTH (3,3), IORTH (3,3), AEQ (3,3)
  85. REAL*8 H1 (6,6), H2(6,6), H3(6,6)
  86. REAL*8 H01 (6,6), H02(6,6), H03(6,6)
  87. REAL*8 K01 (6,6), K02(6,6), K03(6,6), KW(6,6)
  88. REAL*8 KEFF1(6,6), KEFF2(6,6), KEFF3(6,6)
  89. REAL*8 RIG0 (6,6), CED0 (6,6)
  90. REAL*8 SORTH(6), SIG0V(6), SIGFV(6),
  91. & DEFI(6), DEPSTV(6), DORTH(6)
  92. REAL*8 VARTMP
  93. INTEGER HCLO1, HCLO2, HCLO3
  94.  
  95. * scalar damage indicators
  96. REAL*8 DOM1, DOM2, DOM3
  97. REAL*8 YGR1, YGR2, YGR3, YW(6)
  98. REAL*8 YEQ1, YEQ2, YEQ3
  99. *
  100. * PHENOMENOLOGICAL COEFFICIENTS
  101. *
  102. * deactivation parameter (scalars)
  103. REAL*8 ETADS
  104. * closure stress
  105. * REAL*8 SIGCLO (NSTRSS)
  106. *!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  107. *ON NE LE PREND PAS EN COMPTE!!!!
  108. *!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  109.  
  110. * scalar damage law parameters
  111. REAL*8 G1DC, G1Y0, G1YC, G1P
  112. REAL*8 G2DC, G2Y0, G2YC, G2P
  113. REAL*8 G3DC, G3Y0, G3YC, G3P
  114.  
  115. * Passes comme param. materiau
  116. * DATA G1DC, G1Y0, G1YC, G1P
  117. * & / 0.6, 130.0, 400.0, 1.0/
  118. * DATA G2DC, G2Y0, G2YC, G2P
  119. * & / 0.6, 130.0, 400.0, 1.0/
  120. * DATA G3DC, G3Y0, G3YC, G3P
  121. * & / 0.6, 130.0, 400.0, 1.0/
  122.  
  123. DATA ETADS /1./
  124.  
  125. DATA H1
  126. & /1.0, 0.0, 0.0, 0.0, 0.0, 0.0,
  127. & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
  128. & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
  129. & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
  130. & 0.0, 0.0, 0.0, 0.0, 0.7, 0.0,
  131. & 0.0, 0.0, 0.0, 0.0, 0.0, 0.7/
  132. DATA H2
  133. & /0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
  134. & 0.0, 1.0, 0.0, 0.0, 0.0, 0.0,
  135. & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
  136. & 0.0, 0.0, 0.0, 0.7, 0.0, 0.0,
  137. & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
  138. & 0.0, 0.0, 0.0, 0.0, 0.0, 0.7/
  139. DATA H3
  140. & /0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
  141. & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
  142. & 0.0, 0.0, 1.0, 0.0, 0.0, 0.0,
  143. & 0.0, 0.0, 0.0, 0.7, 0.0, 0.0,
  144. & 0.0, 0.0, 0.0, 0.0, 0.7, 0.0,
  145. & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/
  146. DATA AEQ
  147. & /1.0, 0.0, 0.0,
  148. & 0.0, 1.0, 0.0,
  149. & 0.0, 0.0, 1.0/
  150.  
  151. ***** INITIALIZATION VARIABLES
  152. *
  153. kerre=0
  154. * Proprietes materiau
  155. YG1 = XMAT(1)
  156. YG2 = XMAT(2)
  157. YG3 = XMAT(3)
  158. XNU12 = XMAT(4)
  159. XNU23 = XMAT(5)
  160. XNU13 = XMAT(6)
  161. G12 = XMAT(7)
  162. G23 = XMAT(8)
  163. G13 = XMAT(9)
  164.  
  165. G1DC = XMAT(16)
  166. G1Y0 = XMAT(17)
  167. G1YC = XMAT(18)
  168. G1P = XMAT(19)
  169. G2DC = XMAT(20)
  170. G2Y0 = XMAT(21)
  171. G2YC = XMAT(22)
  172. G2P = XMAT(23)
  173. G3DC = XMAT(24)
  174. G3Y0 = XMAT(25)
  175. G3YC = XMAT(26)
  176. G3P = XMAT(27)
  177.  
  178. H1(5,5)= XMAT(29)
  179. H3(5,5)= XMAT(29)
  180.  
  181. H1(6,6)= XMAT(30)
  182. H2(6,6)= XMAT(30)
  183.  
  184. H2(4,4)= XMAT(28)
  185. H3(4,4)= XMAT(28)
  186.  
  187. AEQ(1,2)= XMAT(35)
  188. AEQ(2,1)= XMAT(35)
  189.  
  190. AEQ(1,3)= XMAT(37)
  191. AEQ(3,1)= XMAT(37)
  192.  
  193. AEQ(2,3)= XMAT(36)
  194. AEQ(3,2)= XMAT(36)
  195.  
  196. * Pour deboggage
  197. C* jPARAM=0
  198.  
  199. * Variables internes du modele
  200. DOM1=VAR0(2)
  201. DOM2=VAR0(3)
  202. DOM3=VAR0(4)
  203.  
  204. * Mise a zero des matrices
  205. CALL ZERO (RIG0,6,6)
  206. CALL ZERO (CED0,6,6)
  207.  
  208. ****** CALCUL DE LA DEFORMATION INITIALE A PARTIR
  209. ****** DES CONTRAINTES INITIALES
  210.  
  211. **********Debougage
  212. C* IF (jPARAM.EQ.1) THEN
  213. C* WRITE(IOIMP,66770) IB,IGAU
  214. C*66770 format(////////2x,'element ',i6,2x,'point ',i3//)
  215. C*
  216. C* WRITE (IOIMP,*) 'Increment des deformations '
  217. C* WRITE (IOIMP,99999) (DEPST(ILOOP), ILOOP=1,6)
  218. C*
  219. C* WRITE (IOIMP,*) 'Contraintes au debut de l''iteration'
  220. C* WRITE (IOIMP,99999) (SIG0(ILOOP), ILOOP=1,6)
  221. C* ENDIF
  222. **********Debougage
  223.  
  224. * Controle si il faut calculer la matrice de hooke
  225.  
  226. IF (IB.EQ.1.AND.IGAU.EQ.1) THEN
  227. GOTO 100
  228.  
  229. ELSEIF (N2PTEL.EQ.1.AND.N2EL.EQ.1) THEN
  230. GOTO 200
  231.  
  232. ELSEIF (N2PTEL.EQ.1.AND.N2EL.NE.1) THEN
  233. IF (IGAU.EQ.1) THEN
  234. GOTO 100
  235. ELSE
  236. GOTO 200
  237. ENDIF
  238.  
  239. ELSE
  240. GOTO 100
  241. ENDIF
  242.  
  243. * Calcul de la matrice de hook pour un materiau orthotrope
  244. 100 CONTINUE
  245. * WRITE (IOIMP,*) 'Calcul de la matrice de Hooke, CMATE=', CMATE
  246.  
  247. IPERR=1
  248. CALL ZERO (DDAUX,LHOOK,LHOOK)
  249.  
  250. XNU21=(YG2/YG1)*XNU12
  251. XNU32=(YG3/YG2)*XNU23
  252. XNU31=(YG3/YG1)*XNU13
  253. AUX=(1.D0-XNU12*XNU21-XNU23*XNU32-XNU13*XNU31
  254. & -2.D0*XNU21*XNU32*XNU13)
  255. AUX1=AUX/YG1
  256. AUX2=AUX/YG2
  257. AUX3=AUX/YG3
  258.  
  259. DDAUX(1,1)=(1.D0-XNU23*XNU32)/AUX1
  260. DDAUX(1,2)=(XNU21+XNU31*XNU23)/AUX1
  261. DDAUX(2,1)=DDAUX(1,2)
  262. DDAUX(1,3)=(XNU31+XNU21*XNU32)/AUX1
  263. DDAUX(3,1)=DDAUX(1,3)
  264. DDAUX(2,2)=(1.D0-XNU13*XNU31)/AUX2
  265. DDAUX(2,3)=(XNU32+XNU12*XNU31)/AUX2
  266. DDAUX(3,2)=DDAUX(2,3)
  267. DDAUX(3,3)=(1.D0-XNU12*XNU21)/AUX3
  268. DDAUX(4,4)=G23
  269. DDAUX(5,5)=G13
  270. DDAUX(6,6)=G12
  271.  
  272. * WRITE (IOIMP,*) 'Valeurs calculees:'
  273. * DO 110 ILOOP= 1,LHOOK
  274. * WRITE (IOIMP, 99999 ) (DDAUX (ILOOP,J), J=1,LHOOK)
  275. *110 CONTINUE
  276.  
  277. * On recopie la matrice de hook pour l'inversee
  278. 200 DO 205 ILOOP=1,LHOOK
  279. DO 205 JLOOP=1,LHOOK
  280. IDAUX(ILOOP,JLOOP)= DDAUX(ILOOP,JLOOP)
  281. 205 CONTINUE
  282.  
  283. * Inversion de la matrice de hook
  284. * WRITE (IOIMP,*) 'Inversion de la matrice de Hooke'
  285. TPREC= 0.D0
  286. IPERR=0
  287. CALL INVALM(IDAUX,LHOOK,LHOOK,IPERR,TPREC)
  288. IF (IPERR.NE.0) THEN
  289. WRITE (IOIMP,*) 'ERREUR DANS L''INVERSION DE LA MATRICE DE HOOK'
  290. ENDIF
  291.  
  292. * WRITE (IOIMP,*) 'Matrice de Hook inverse'
  293. * DO 210 ILOOP= 1,LHOOK
  294. * WRITE (IOIMP,99999) (IDAUX (ILOOP,J), J=1,LHOOK)
  295. *210 CONTINUE
  296.  
  297. * Calcul des tenseurs d'endommagement H01, H02, H03
  298. CALL SICTEN (H1,IDAUX,H01)
  299. CALL SICTEN (H2,IDAUX,H02)
  300. CALL SICTEN (H3,IDAUX,H03)
  301.  
  302. **********Debougage
  303. C* IF (jPARAM.EQ.1) THEN
  304. C* WRITE (IOIMP,*) 'Matrice H01'
  305. C* DO 250 ILOOP= 1,LHOOK
  306. C* WRITE (IOIMP, 99999 ) (H01(ILOOP,J), J=1,LHOOK)
  307. C*250 CONTINUE
  308. C*
  309. C* WRITE (IOIMP,*) 'Matrice H02'
  310. C* DO 251 ILOOP= 1,LHOOK
  311. C* WRITE (IOIMP, 99999 ) (H02(ILOOP,J), J=1,LHOOK)
  312. C*251 CONTINUE
  313. C*
  314. C* WRITE (IOIMP,*) 'Matrice H03'
  315. C* DO 252 ILOOP= 1,LHOOK
  316. C* WRITE (IOIMP, 99999 ) (H03(ILOOP,J), J=1,LHOOK)
  317. C*252 CONTINUE
  318. C* ENDIF
  319. C*
  320. C** Calcul des matrices K01,K02,K03
  321. CALL MULMAT (KW,H01,DDAUX,LHOOK,LHOOK,LHOOK)
  322. CALL MULMAT (K01,DDAUX,KW,LHOOK,LHOOK,LHOOK)
  323.  
  324. CALL MULMAT (KW,H02,DDAUX,LHOOK,LHOOK,LHOOK)
  325. CALL MULMAT (K02,DDAUX,KW,LHOOK,LHOOK,LHOOK)
  326.  
  327. CALL MULMAT (KW,H03,DDAUX,LHOOK,LHOOK,LHOOK)
  328. CALL MULMAT (K03,DDAUX,KW,LHOOK,LHOOK,LHOOK)
  329.  
  330. * WRITE (IOIMP,*) 'Matrice K01'
  331. * DO 300 ILOOP= 1,LHOOK
  332. * WRITE (IOIMP, 99999 ) (K01(ILOOP,J), J=1,LHOOK)
  333. *300 CONTINUE
  334. *
  335. * WRITE (IOIMP,*) 'Matrice K02'
  336. * DO 301 ILOOP= 1,LHOOK
  337. * WRITE (IOIMP, 99999 ) (K02(ILOOP,J), J=1,LHOOK)
  338. *301 CONTINUE
  339. *
  340. * WRITE (IOIMP,*) 'Matrice K03'
  341. * DO 302 ILOOP= 1,LHOOK
  342. * WRITE (IOIMP, 99999 ) (K03(ILOOP,J), J=1,LHOOK)
  343. *302 CONTINUE
  344.  
  345. ***** Recuperation deformation initiale dans le repere orth.
  346.  
  347. DEFI(1)=VAR0(5)
  348. DEFI(2)=VAR0(6)
  349. DEFI(3)=VAR0(7)
  350. DEFI(4)=VAR0(8)
  351. DEFI(5)=VAR0(9)
  352. DEFI(6)=VAR0(10)
  353.  
  354. C* IF (jPARAM.EQ.1) THEN
  355. C* WRITE (IOIMP,*) 'DEFORMATION RECUPEREE'
  356. C* WRITE (IOIMP,99999) (DEFI(ILOOP), ILOOP=1,6)
  357. C* ENDIF
  358.  
  359. * Calcul de l'increment de deformation dans le repere orthotrope
  360. DO 451 ILOOP=1,6
  361. DEPSTV(ILOOP)=DEPST(ILOOP)
  362. 451 CONTINUE
  363.  
  364. CALL CICROT (wrk52,wrk53,wrk54,1,DEPSTV,DORTH)
  365.  
  366. C* IF (jPARAM.EQ.1) THEN
  367. C* WRITE (IOIMP,*) 'Increment des deformations orth. '
  368. C* WRITE (IOIMP,99999) (DORTH(ILOOP), ILOOP=1,6)
  369. C* ENDIF
  370.  
  371. * Reorganisation dans SICDEF selon la valeur de iAXEP
  372. * TC iaxep n'est pas initialise , je le mets à 0 !!!
  373. iaxep=0
  374. CALL SICDEF (DORTH,iAXEP,kerre)
  375. * Reorganisation supplementaire pour le contraintes en cisaillement
  376. VARTMP= DORTH(4)
  377. DORTH(4)= DORTH(6)
  378. DORTH(6)= VARTMP
  379. DORTH(5)= DORTH(5)
  380.  
  381. C* IF (jPARAM.EQ.1) THEN
  382. C* WRITE (IOIMP,*) 'Apres SICDEF et reorg.'
  383. C* WRITE (IOIMP,*) 'Increment des deformations orth. reorganise'
  384. C* WRITE (IOIMP,99999) (DORTH(ILOOP), ILOOP=1,6)
  385. C* ENDIF
  386.  
  387. * On calcule les deformation totales.
  388. DO 500 ILOOP=1,NSTRSS
  389. DORTH(ILOOP)=DEFI(ILOOP)+DORTH(ILOOP)
  390. * On garde le deformations totales dans le var. internes
  391. VARF(ILOOP+4)=DORTH(ILOOP)
  392. 500 CONTINUE
  393.  
  394. C* IF (jPARAM.EQ.1) THEN
  395. C* WRITE (IOIMP,*) 'Calcul des def. totales (rep. orth. reorg.)'
  396. C* WRITE (IOIMP,99999) (DORTH(ILOOP), ILOOP=1,6)
  397. C* ENDIF
  398.  
  399. ********************************************************
  400. ** ON A LES DEFORMATIONS TOTALES **
  401. ** ON PEUT CALCULER LES CONTRAINTES A LA FIN DU PAS **
  402. ********************************************************
  403. * WRITE (IOIMP,*) 'Calcul contraintes'
  404.  
  405. * Calcul des noveaux HCLO
  406.  
  407. IF (DORTH(1).LT.0.) THEN
  408. HCLO1=1
  409. ELSE
  410. HCLO1=0
  411. ENDIF
  412. IF (DORTH(2).LT.0.) THEN
  413. HCLO2=1
  414. ELSE
  415. HCLO2=0
  416. ENDIF
  417. IF (DORTH(3).LT.0.) THEN
  418. HCLO3=1
  419. ELSE
  420. HCLO3=0
  421. ENDIF
  422.  
  423. C* IF (jPARAM.EQ.1) THEN
  424. C* WRITE (IOIMP,*) 'HCLO'
  425. C* WRITE (IOIMP,*) HCLO1,HCLO2,HCLO3
  426. C* ENDIF
  427.  
  428. * Calcul des nouvelles KEFF
  429. DO 505 ILOOP=1,LHOOK
  430. DO 505 JLOOP=1,LHOOK
  431. KEFF1(ILOOP,JLOOP)=K01(ILOOP,JLOOP)
  432. KEFF2(ILOOP,JLOOP)=K02(ILOOP,JLOOP)
  433. KEFF3(ILOOP,JLOOP)=K03(ILOOP,JLOOP)
  434. 505 CONTINUE
  435. KEFF1(1,1)=K01(1,1)*(1.-ETADS*HCLO1)
  436. KEFF2(2,2)=K02(2,2)*(1.-ETADS*HCLO2)
  437. KEFF3(3,3)=K03(3,3)*(1.-ETADS*HCLO3)
  438.  
  439. * WRITE (IOIMP,*) 'Matrice KEFF1'
  440. * DO 502 ILOOP= 1,LHOOK
  441. * WRITE (IOIMP, 99999 ) (KEFF1(ILOOP,J), J=1,LHOOK)
  442. *502 CONTINUE
  443. *
  444. * WRITE (IOIMP,*) 'Matrice KEFF2'
  445. * DO 503 ILOOP= 1,LHOOK
  446. * WRITE (IOIMP, 99999 ) (KEFF2(ILOOP,J), J=1,LHOOK)
  447. *503 CONTINUE
  448. *
  449. * WRITE (IOIMP,*) 'Matrice KEFF3'
  450. * DO 504 ILOOP= 1,LHOOK
  451. * WRITE (IOIMP, 99999 ) (KEFF3(ILOOP,J), J=1,LHOOK)
  452. *504 CONTINUE
  453.  
  454. * Calcul des YGR
  455. * WRITE (IOIMP,*) 'YW1'
  456. CALL ZERO (YW,6,1)
  457. CALL MULMAT (YW,KEFF1,DORTH,6,1,6)
  458. * WRITE (IOIMP,*) (YW(ILOOP), ILOOP=1,6)
  459. YGR1=0.
  460. DO 510 ILOOP=1,6
  461. YGR1=YGR1+YW(ILOOP)*DORTH(ILOOP)
  462. 510 CONTINUE
  463. YGR1=0.5D0*YGR1
  464. * WRITE (IOIMP,*) 'YGR1=',YGR1
  465.  
  466. CALL ZERO (YW,6,1)
  467. CALL MULMAT (YW,KEFF2,DORTH,6,1,6)
  468. * WRITE (IOIMP,*) 'YW2'
  469. * WRITE (IOIMP,*) (YW(ILOOP), ILOOP=1,6)
  470. YGR2=0.
  471. DO 520 ILOOP=1,6
  472. YGR2=YGR2+YW(ILOOP)*DORTH(ILOOP)
  473. 520 CONTINUE
  474. YGR2=0.5D0*YGR2
  475.  
  476. CALL ZERO (YW,6,1)
  477. CALL MULMAT (YW,KEFF3,DORTH,6,1,6)
  478. YGR3=0.
  479. DO 530 ILOOP=1,6
  480. YGR3=YGR3+YW(ILOOP)*DORTH(ILOOP)
  481. 530 CONTINUE
  482. YGR3=0.5D0*YGR3
  483.  
  484. C* IF (jPARAM.EQ.1) THEN
  485. C* WRITE (IOIMP,*) 'YGR1=',YGR1
  486. C* WRITE (IOIMP,*) 'YGR2=',YGR2
  487. C* WRITE (IOIMP,*) 'YGR3=',YGR3
  488. C* ENDIF
  489.  
  490. IF (YGR1.LT.0.) THEN
  491. YGR1=0.
  492. ENDIF
  493. IF (YGR2.LT.0.) THEN
  494. YGR2=0.
  495. ENDIF
  496. IF (YGR3.LT.0.) THEN
  497. YGR3=0.
  498. ENDIF
  499.  
  500. *Calcul des YEQ
  501. YEQ1= AEQ(1,1)*YGR1+AEQ(1,2)*YGR2+AEQ(1,3)*YGR3
  502. YEQ2= AEQ(2,1)*YGR1+AEQ(2,2)*YGR2+AEQ(2,3)*YGR3
  503. YEQ3= AEQ(3,1)*YGR1+AEQ(3,2)*YGR2+AEQ(3,3)*YGR3
  504.  
  505. *Calcul des DOM
  506.  
  507. DD1= ((SQRT(YEQ1) - G1Y0)/ G1YC )
  508. DD2= ((SQRT(YEQ2) - G2Y0)/ G2YC )
  509. DD3= ((SQRT(YEQ3) - G3Y0)/ G3YC )
  510.  
  511. IF (DD1.LT.0.) THEN
  512. DD1=0.
  513. ENDIF
  514. IF (DD2.LT.0.) THEN
  515. DD2=0.
  516. ENDIF
  517. IF (DD3.LT.0.) THEN
  518. DD3=0.
  519. ENDIF
  520.  
  521. DOM1= G1DC*(1.D0 - EXP(-1.* ( DD1**G1P ) ) )
  522. DOM2= G2DC*(1.D0 - EXP(-1.* ( DD2**G2P ) ) )
  523. DOM3= G3DC*(1.D0 - EXP(-1.* ( DD3**G3P ) ) )
  524.  
  525. DOM1= MAX(DOM1,VAR0(2))
  526. DOM2= MAX(DOM2,VAR0(3))
  527. DOM3= MAX(DOM3,VAR0(4))
  528.  
  529. C* IF (jPARAM.EQ.1) THEN
  530. C* WRITE (IOIMP,*) 'DOM1=',DOM1
  531. C* WRITE (IOIMP,*) 'DOM2=',DOM2
  532. C* WRITE (IOIMP,*) 'DOM3=',DOM3
  533. C* ENDIF
  534.  
  535. *Calcul de la matrice de rigidite
  536.  
  537. DO 600 ILOOP=1,LHOOK
  538. DO 600 JLOOP=1,LHOOK
  539. RIG0(ILOOP,JLOOP)=DDAUX(ILOOP,JLOOP)
  540. & -DOM1*KEFF1(ILOOP,JLOOP)
  541. & -DOM2*KEFF2(ILOOP,JLOOP)
  542. & -DOM3*KEFF3(ILOOP,JLOOP)
  543. 600 CONTINUE
  544.  
  545. * WRITE (IOIMP, *) 'Matrice RIG0 finale'
  546. * DO 610 ILOOP= 1,LHOOK
  547. * WRITE (IOIMP,99999) (RIG0 (ILOOP,J), J=1,LHOOK)
  548. *610 CONTINUE
  549.  
  550. * Calcul des contraintes a la fin du pas
  551. * SORTH contient les contraintes a la fin du pas
  552. * dans le repere orthotrope
  553. CALL MULMAT (SORTH,RIG0,DORTH,6,1,6)
  554.  
  555. C* IF (jPARAM.EQ.1) THEN
  556. C* WRITE (IOIMP,*) 'Contraintes calculees (repere orth.)'
  557. C* WRITE (IOIMP,99999) (SORTH(ILOOP), ILOOP=1,6)
  558. C* ENDIF
  559.  
  560. * ATTENTION:
  561. * On reorganise les contraintes en cisaillement pour
  562. * calculer les contraintes dans le repere global
  563. SIGFV(1)=SORTH(1)
  564. SIGFV(2)=SORTH(2)
  565. SIGFV(3)=SORTH(3)
  566.  
  567. SIGFV(4)=SORTH(6)
  568. SIGFV(5)=SORTH(5)
  569. SIGFV(6)=SORTH(4)
  570.  
  571. CALL SICCNT (SIGFV,iAXEP,kerre)
  572.  
  573. C* IF (jPARAM.EQ.1) THEN
  574. C* WRITE (IOIMP,*) 'Apres SICCNT e reorg'
  575. C* WRITE (IOIMP,*) 'Contraintes reorganisees'
  576. C* WRITE (IOIMP,99999) (SIGFV(ILOOP), ILOOP=1,6)
  577. C* ENDIF
  578.  
  579. * On appele SICROT pour trouver le contraintes dans le repere global
  580. * On utilise SORTH pour garder le resultat
  581. * (on peut pas passer SIGF a la subroutine car il est dans un segment)
  582. CALL CICROT (wrk52,wrk53,wrk54,0,SIGFV,SORTH)
  583.  
  584. * On recopie SORTH in SIGF
  585. DO 1000 ILOOP=1,6
  586. SIGF(ILOOP)=SORTH(ILOOP)
  587. 1000 CONTINUE
  588.  
  589. C* IF (jPARAM.EQ.1) THEN
  590. C* WRITE (IOIMP,*) 'Contraintes calculees'
  591. C* WRITE (IOIMP,99999) (SIGF(ILOOP), ILOOP=1,6)
  592. C* ENDIF
  593.  
  594. VARF(2)= DOM1
  595. VARF(3)= DOM2
  596. VARF(4)= DOM3
  597.  
  598. 99999 format(2x,' ',(6(1x,3pe12.5),/))
  599. 99998 format(2x,' ',(4(1x,3pe12.5),/))
  600. 99997 format(2x,' ',(1x,3pe12.5),/)
  601. 99996 format(2x,' ',(3(1x,1pe12.3),/))
  602.  
  603. RETURN
  604. END
  605.  
  606.  
  607.  
  608.  
  609.  
  610.  
  611.  

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