C MISTR0 SOURCE STRU 06/12/14 21:15:21 5611 c Sous-Programme principal du module MISTRAL0 C -------------------------------------------------------------------------- SUBROUTINE MISTR0 (TT,TTP,FI,FIT, SIG, XX,EPSE,EPSEQ,PSI,KPLAST, & CSIG,CEPS,CSIEP0, IUI, & PDILT,PCOEL, NDPI,NDVP,NXX, & PCOHI,PECOU,PEDIR,PRVCE,PECRX,PDVDI, PCROI, & SEQ,RR, & SIGP, VEPS,VEPSTH,VEPSEL,VEPSP,VEPSCR, & VEPSE,EPSEQP,XXP,PSIP, & ISTOP) C -------------------------------------------------------------------------- C Determination, a un instant quelconque : C - des contraintes equivalentes SEQ(IDP), C - des contraintes seuil RR(IDP), C - des derivees des contraintes par rapport au temps SIGP(IJ), C - des vitesses de deformation totale VEPS(IJ), C - des vitesses de dilatation thermique VEPSTH(IJ), C - des vitesses de deformation elastique VEPSEL(IJ), C - des vitesses de deformations plastiques VEPSP(IJ,IDP), C - des vitesses de croissance VEPSCR(IJ), C - des vitesses de deformations plastiques equivalentes VEPSE(IDP), C - des derivees des deformations plastiques equivalentes EPSEQP(IDP), C - des derivees des contraintes internes XXP(IJ,IXX), C - de la derivee PSIP de la variable de durcissement du a l'irradiation C PSI, si elle existe, C en fonction : C - de la temperature TT, C - de sa derivee par rapport au temps TTP, C - du flux de neutrons rapides FI, C - de la fluence de neutrons rapides FIT, C - des contraintes SIG(IJ), C - des contraintes internes XX(IJ,IXX), C - des deformations equivalentes EPSE(IDP) et EPSEQ(IDP), C - de l'eventuelle variable PSI de durcissement du a l'irradiation, C - de la variable KPLAST (0 : elastique, 1 : plastique), C - des conditions mecaniques imposees : CSIG*SIGP + CEPS*VEPS = CSIEP0 C - des parametres du modele, pour le materiau au point considere, transmis C dans PDILT, PCOEL, PCOHI, PECOU, PEDIR, PRVCE, PECRX, PDVDI et PCROI. C -------------------------------------------------------------------------- C IJ dans l'ordre : 11, 22, 33, 12, 13, 23 C IDP compris entre 1-NDPI et NDVP C IXX compris entre 1 et NXX C -------------------------------------------------------------------------- C Resolution du systeme d'equations suivant : C - conditions mecaniques imposees : C CSIG*SIGP + CEPS*VEPS = CSIEP0 C - equations issues des lois de deformation du materiau : C NDVP C VEPS(IJ) = VEPSTH(IJ) + VEPSEL(IJ) + SOMME ( VEPSP(IJ,IDP) ) + VEPSCR(IJ) C IDP=1-KPLAST C avec : VEPSEL = VEPEL0 + SOEL*SIGP C et, si KPLAST=1 : VEPSP(IJ,0) = DSESDS(IJ)*VEPSE(0) C soit : VEPS = VEPS0 + SOEL*SIGP (+VEPSE(0)*DSESDS) C - relation de consistance, si KPLAST=1 : C SOMME ( DSESDS(IJ)*SIGP(IJ) ) + A77*VEPSE(0) = B7 C IJ C -------------------------------------------------------------------------- IMPLICIT INTEGER (I-N) IMPLICIT REAL*8 (A-H, O-Z) c std : PARAMETER ( NDVPMA = 4 , NXXMAX = 3 ) c std. DIMENSION SIG(1:*),XX(1:6,1:*),EPSE(0:*),EPSEQ(0:*) DIMENSION CSIG(1:6,1:*),CEPS(1:6,1:*),CSIEP0(1:*) DIMENSION PDILT(1:*),PCOEL(1:*),PCOHI(1:*),PECOU(1:*), & PEDIR(1:*),PRVCE(1:*),PECRX(1:*),PDVDI(1:*),PCROI(1:*) DIMENSION SOEL(1:6,1:6),VEPEL0(1:6) c std : DIMENSION VEPS0(1:6),DSESDS(1:6),EPEQP0(0:NDVPMA), & XXP0(1:6,1:NXXMAX) c std. DIMENSION A0(1:6,1:6),B0(1:6),B00(1:6,1:1), & A1(1:7,1:7),B1(1:7,1:1),ISOL(1:1) DIMENSION SIGP0(1:6,1:1),SIPVE(1:7,1:1) DIMENSION SEQ(0:*),RR(0:*), & SIGP(1:*),VEPS(1:*),VEPSTH(1:*),VEPSEL(1:*), & VEPSP(1:6,0:*),VEPSCR(1:*), & VEPSE(0:*),EPSEQP(0:*),XXP(1:6,1:*) CALL DILTH (TT,TTP, PDILT, VEPSTH) CALL ELAST (TT,TTP,SIG, PCOEL, SOEL,VEPEL0) CALL PLAST (TT,TTP,FI,FIT, SIG, XX,EPSE,EPSEQ,PSI,KPLAST, & NDPI,NDVP, NXX, & PCOHI,PECOU,PEDIR,PRVCE,PECRX,PDVDI, & SEQ,RR, VEPSP,VEPSE,EPSEQP,EPEQP0, XXP,XXP0, & PSIP,PSIP0, DSESDS,A77,B7) CALL CROIS (TT,FI,FIT, PCROI, VEPSCR) DO L = 1,6 VEPS0(L) = VEPSTH(L)+VEPEL0(L)+VEPSCR(L) DO IDP = 1,NDVP VEPS0(L) = VEPS0(L)+VEPSP(L,IDP) END DO END DO CALL PRODMA(CEPS,SOEL,6,6,6, A0) CALL PRODMA(CEPS,VEPS0,6,6,1, B0) IF (KPLAST.EQ.0) THEN DO L = 1,6 DO K = 1,6 A0(K,L) = CSIG(K,L)+A0(K,L) END DO B00(L,1) = CSIEP0(L)-B0(L) END DO CALL GAUSS (A0,B00,6,1, SIGP0, ISOL) DO IJ = 1,6 SIGP(IJ) = SIGP0(IJ,1) END DO ELSE DO L = 1,6 DO K = 1,6 A1(K,L) = CSIG(K,L)+A0(K,L) END DO B1(L,1) = CSIEP0(L)-B0(L) END DO CALL PRODMA(CEPS,DSESDS,6,6,1, B0) DO IJ = 1,3 A1(7,IJ) = B0(IJ) A1(IJ,7) = DSESDS(IJ) END DO DO IJ = 4,6 A1(7,IJ) = B0(IJ) A1(IJ,7) = 2.*DSESDS(IJ) END DO A1(7,7) = A77 B1(7,1) = B7 CALL GAUSS (A1,B1,7,1, SIPVE, ISOL) VEPSE(0) = SIPVE(7,1) DO IJ = 1,6 SIGP(IJ) = SIPVE(IJ,1) VEPSP(IJ,0) = DSESDS(IJ)*VEPSE(0) END DO END IF IF (ISOL(1).NE.1) THEN WRITE (IUI,600) WRITE (IUI,601) ISOL(1) 601 FORMAT (' Arret au sous-programme MISTR0 :',/, & ' 0 : aucune solution',/, & ' 2 : infinite de solutions',/,2X,I1) ISTOP = 1 RETURN END IF CALL PRODMA(SOEL,SIGP,6,6,1, VEPSEL) DO IJ = 1,6 VEPS(IJ) = VEPS0(IJ)+VEPSEL(IJ) IF (KPLAST.EQ.1) VEPS(IJ) = VEPS(IJ)+VEPSP(IJ,0) VEPSEL(IJ) = VEPEL0(IJ)+VEPSEL(IJ) END DO IF (KPLAST.EQ.1) THEN DO IDP = 0,NDVP EPSEQP(IDP) = EPSEQP(IDP)+EPEQP0(IDP)*VEPSE(0) END DO DO IXX = 1,NXX DO IJ = 1,6 XXP(IJ,IXX) = XXP(IJ,IXX)+XXP0(IJ,IXX)*VEPSE(0) END DO END DO PSIP = PSIP+PSIP0*VEPSE(0) END IF RETURN 600 FORMAT (/,'iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii',/) END