Sources Esope | Cast3M

mistr0
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