Sources Esope | Cast3M

ecrxx
C ECRXX     SOURCE    STRU      08/12/22    21:15:14     6246
c     Sous-Programme du module MISTRAL0
C     --------------------------------------------------------------------------
      SUBROUTINE ECRXX (VEPSP,VEPSE,XX, TT,EPSEQ,FI,FIT,PSI,
     &                  IXX,NXX, NDPI,NDVP, NPECRX,PECRX,PDVDI,
     &                  XXP,XXP0)
C     --------------------------------------------------------------------------
C     Calcul, pour les contraintes internes de nature IXX :
C     - des termes XXP(IJ,IXX) et XXP0(IJ,IXX) de l'expression suivante
C       des derivees par rapport au temps des contraintes internes :
C            dXX(IJ,IXX)/dt = XXP(IJ,IXX) + XXP0(IJ,IXX)*VEPSE(0)
C     en fonction :
C     - des vitesses de deformation VEPSP(IJ,IDP)
C       (si KPLAST=1, VEPSP(IJ,0) correspond a VEPSE(0)=1),
C     - des vitesses de deformation equivalente VEPSE(IDP),
C     - des contraintes internes XX(IJ,IXXP),
C     - de la temperature TT,
C     - des deformations equivalentes EPSEQ(IDP),
C     - du flux de neutrons rapides FI,
C     - de la fluence FIT et de la variable PSI de durcissement du a
C       l'irradiation,
C     - des parametres transmis dans PECRX et PDVDI.
C     NPECRX (incremente ici) etant en entree le nombre de ceux de PECRX
C     correspondant aux contraintes internes de natures IXXP &lt; IXX.
C     IDP compris entre 1-NDPI et NDVP.
C     IXXP compris entre 1 et NXX.
C     --------------------------------------------------------------------------
      IMPLICIT INTEGER (I-N)
      IMPLICIT REAL*8 (A-H, O-Z)
      PARAMETER ( NPTTM = 5 , NPPSIM = 6 )
      PARAMETER ( NPEDIM = 13+6*NPTTM+NPPSIM )
c     (NPEDIM = 49)
      PARAMETER ( NVM=2 , NPATDM = 14 , NPFIM = 9 )
      PARAMETER ( NPERVM = 11+NVM*(NPEDIM+2*NPATDM+NPFIM+11) )
c     (NPERVM = 205)
      DIMENSION VEPSP(1:6,0:*),VEPSE(0:*),EPSEQ(0:*),XX(1:6,1:*)
      DIMENSION PECRX(1:*),PDVDI(1:*)
      DIMENSION ECXX(1:6),HM(1:6),XM(1:6),YM(1:6),SXM(1:6)
      DIMENSION PECDI(1:NPEDIM),PERV(1:NPERVM)
      DIMENSION XXP(1:6,1:*),XXP0(1:6,1:*)
      DO IJ = 1,6
       XXP(IJ,IXX) = 0.
       XXP0(IJ,IXX) = 0.
      END DO
      NPDVDI = NDPI+NDVP+IXX
      KVDI = NINT(PDVDI(NPDVDI))
      IF (KVDI.EQ.0) THEN
       PSIIXX = FIT
      ELSE
       PSIIXX = PSI
      END IF
C     -----------------------
C       Ecrouissage cinematique
C
      DO IJ = 1,6
       ECXX(IJ) = PECRX(NPECRX+IJ)
       SXM(IJ) = 0.
      END DO
      NPECRX = NPECRX+6
      DO IDP = 1-NDPI,NDVP
       NPECRX = NPECRX+1
       NPECDI = NINT(PECRX(NPECRX))
       KCC = NINT(PECRX(NPECRX+1))
       IF (KCC.EQ.0) THEN
        NPECRX = NPECRX+1
       ELSE
        IF (KCC.EQ.-1) THEN
         NPECRX = NPECRX+2
         CC = PECRX(NPECRX)
        ELSE
         DO IP = 1,NPECDI
          PECDI(IP) = PECRX(NPECRX+IP)
         END DO
         NPECRX = NPECRX+NPECDI
         CALL FECRDI (TT,EPSEQ(IDP),PSIIXX, 0, PECDI,
     &                CC,DSRDTT,DSRDEP,DSRPSI)
        END IF
        DO IJ = 1,6
         XM(IJ) = CC*VEPSP(IJ,IDP)
        END DO
        IF (IDP.EQ.0) THEN
         CALL PROMAH (ECXX,XM, YM)
         DO IJ = 1,6
          XXP0(IJ,IXX) = YM(IJ)
         END DO
        ELSE
         DO IJ = 1,6
          SXM(IJ) = SXM(IJ)+XM(IJ)
         END DO
        END IF
       END IF
      END DO
      CALL PROMAH (ECXX,SXM, YM)
      DO IJ = 1,6
       XXP(IJ,IXX) = YM(IJ)
      END DO
C     ----------------------
C       Restauration dynamique
C
      DO IJ = 1,6
       HM(IJ) = PECRX(NPECRX+IJ)
       SXM(IJ) = 0.
      END DO
      NPECRX = NPECRX+6
      DO IDP = 1-NDPI,NDVP
       DO IJ = 1,6
        XM(IJ) = 0.
       END DO
       DO IXXP = 1,NXX
        NPECRX = NPECRX+1
        NPECDI = NINT(PECRX(NPECRX))
        KDD = NINT(PECRX(NPECRX+1))
        IF (KDD.EQ.0) THEN
         NPECRX = NPECRX+1
        ELSE
         IF (KDD.EQ.-1) THEN
          NPECRX = NPECRX+2
          DD = PECRX(NPECRX)
         ELSE
          DO IP = 1,NPECDI
           PECDI(IP) = PECRX(NPECRX+IP)
          END DO
          NPECRX = NPECRX+NPECDI
          CALL FECRDI (TT,EPSEQ(IDP),PSIIXX, 0, PECDI,
     &                 DD,DSRDTT,DSRDEP,DSRPSI)
         END IF
         DO IJ = 1,6
          XM(IJ) = XM(IJ)+DD*XX(IJ,IXXP)
         END DO
        END IF
       END DO
       IF (IDP.EQ.0) THEN
        CALL PROMAH (HM,XM, YM)
        DO IJ = 1,6
         XXP0(IJ,IXX) = XXP0(IJ,IXX)-YM(IJ)
        END DO
       ELSE
        DO IJ = 1,6
         SXM(IJ) = SXM(IJ)+XM(IJ)*VEPSE(IDP)
        END DO
       END IF
      END DO
      CALL PROMAH (HM,SXM, YM)
      DO IJ = 1,6
       XXP(IJ,IXX) = XXP(IJ,IXX)-YM(IJ)
      END DO
C     --------------------------------
C       Restauration statique eventuelle
C
      NPECRX = NPECRX+1
      KRS = NINT(PECRX(NPECRX))
      IF (KRS.EQ.0) RETURN
      NPECRX = NPECRX+1
      KRS = NINT(PECRX(NPECRX))
      DO IJ = 1,6
       IF (IJ.EQ.3) THEN
        HM(IJ) = PECRX(NPECRX+1)
     &   +PECRX(NPECRX+2)*EXP((PECRX(NPECRX+3)+PECRX(NPECRX+4)*TT)*TT)
        NPECRX = NPECRX+4
       ELSE
        NPECRX = NPECRX+1
        HM(IJ) = PECRX(NPECRX)
       END IF
       XM(IJ) = XX(IJ,IXX)
      END DO
      XEQ = SQRT( HM(1)*(XM(2)-XM(3))**2
     &          + HM(2)*(XM(3)-XM(1))**2 + HM(3)*(XM(1)-XM(2))**2
     &    + 2.*( HM(4)*XM(4)**2 + HM(5)*XM(5)**2 + HM(6)*XM(6)**2 ) )
      NPECRX = NPECRX+1
      NPERV = NINT(PECRX(NPECRX))
      IF (XEQ.EQ.0.D0) THEN
       NPECRX = NPECRX+NPERV
      ELSE
       DO IP = 1,NPERV
        PERV(IP) = PECRX(NPECRX+IP)
       END DO
       NPECRX = NPECRX+NPERV
       CALL ECOREV (XEQ,0.D0,0.D0,TT,FI,PSIIXX, PERV, XXPRS)
       DO IJ = 1,6
        XM(IJ) = XXPRS*XM(IJ)/XEQ
       END DO
       CALL PROMAH (HM,XM, YM)
       IF (KRS.EQ.2) THEN
        DO IJ = 1,6
         XM(IJ) = YM(IJ)
        END DO
        CALL PROMAH (ECXX,XM, YM)
       END IF
       DO IJ = 1,6
        XXP(IJ,IXX) = XXP(IJ,IXX)-YM(IJ)
       END DO
      END IF
C     ---------------------------------
        RETURN
        END