Sources Esope | Cast3M

xxpt1
C XXPT1     SOURCE    CHAT      05/01/13    04:15:53     5004
       SUBROUTINE XXPT1(SIG,EPSV,VAR,EPSVPT,VARPT,XPM,
     +                  XMAT,NSTRS0,NVARI,NCOMAT,MFR)
C
      IMPLICIT INTEGER(I-N)
       IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
       DIMENSION SIG(*),EPSV(*),VAR(*),EPSVPT(*),VARPT(*),XPM(*)
       DIMENSION XMAT(*)
       DIMENSION XX(6),SIG0(6),EPSV0(6),EPS0(6)
       PARAMETER (AMAX = 1.0D20, AMIN = 1.D-20)
C----------------------------------------------------------------
C  ====> Connaissant l'etat, c'est @ dire SIG, EPSV et VAR
C        on calcule les d{riv{es EPSVPT et VARPT ( et XPM )
C        en utilisant les constantes XMAT
C        Il n'y a que (4+NSTRS) valeurs dans VARPT,
C       le reste constitue la m{moire.
C----------------------------------------------------------------
C
C-------  CAS DES COQUES EPAISSES: PASSAGE A 6 COMPOSANTES
C
       IF (MFR.EQ.5) THEN
         NSTRS=NSTRS0+1
         SIG0(1)=SIG(1)
         SIG0(2)=SIG(2)
         SIG0(3)=0.D0
         SIG0(4)=SIG(3)
         SIG0(5)=SIG(4)
         SIG0(6)=SIG(5)
         EPSV0(1)=EPSV(1)
         EPSV0(2)=EPSV(2)
         EPSV0(3)=-1.D0*(EPSV0(1)+EPSV0(2))
         EPSV0(4)=EPSV(3)
         EPSV0(5)=EPSV(4)
         EPSV0(6)=EPSV(5)
      ELSE
         NSTRS=NSTRS0
         DO 01 I=1,NSTRS
           SIG0(I)=SIG(I)
           EPSV0(I)=EPSV(I)
 01      CONTINUE
      ENDIF
C
C-------  AFFECTATION DE QUELQUES VARIABLES
       P1 = VAR(2)
       XN = XMAT(17)
       ALPH2 = VAR(3)
       ALPH4 = VAR(4)
C
C-------  EVALUATION DE J2( SIGMA - X ) = SQRT(3/2* Dev():Dev() )
       DO 69 I=1,NSTRS
        XX(I) = SIG0(I)- VAR(4+I)
 69    CONTINUE
       TRACE = XX(1)+XX(2)+XX(3)
C
       DO 70 I=1,NSTRS
        A = 0.0D0
        IF (I.LE.3) A=1.0D0/3.0D0
        XX(I) = XX(I)-A*TRACE
 70    CONTINUE
       AJ2 = PROCON (XX,XX,NSTRS)
       AJ2 = SQRT(1.5D0*AJ2)
C
C-------  CALCUL DU SEUIL
       R0 = XMAT(8)
       CD = XMAT(9)
C         K = XMAT(6), CK = XMAT(7)
       R = R0*((1.0D0-CD)+CD*ALPH2)
       SEUIL =(AJ2 - R)/( XMAT(6)*( 1.0D0 + XMAT(7)*ALPH2 ) )
C
C-------  CALCUL DE EPS0
C N = XMAT(5)  XPUISS(X,A,AMAX) CALCULE X**A
       IF (SEUIL.GT.0.0D0) THEN
         PPT = XPUISS(SEUIL,XMAT(5),AMAX)
       ELSE
         PPT = 0.0D0
       ENDIF
C
       DO 71 I=1,NSTRS,1
        IF (PPT.EQ.0.0D0) THEN
         EPS0(I) = 0.0D0
         XX(I) = 0.0D0
        ELSE
         XX(I) = XX(I)/AJ2
         EPS0(I) = XX(I)*PPT*1.5D0
        ENDIF
 71    CONTINUE
C
C-------  CALCUL DE P POINT
C             Par definition :
C         PPT = SQRT(2.0/3.0*PROCON(EPS0,EPS0,NSTRS))
       VARPT(1) = PPT
       VARPT(2) = PPT
C
C-------  CALCUL DE LA NORMALE N = 2./3.*DEPSV/DP
C    en fait N // @ EPS0     et @ S - X
C On utilisera N(I) = 2./3.*EPS0(I)/ PPT = XX(I)
C
C-------  CALCUL DE XPT   ( VARPT(4+1..NSTRS) ET XPM)
C         En fait on va differencier  X ainsi :
C       D X  =  XPM * D P1**XM  +  XT * D T
C
C---     PREPARATION DU CALCUL DE XPM = CN.N - CX.X
       IF (PPT.NE.0.0D0) THEN
C             A = XMAT(11), A1 = XMAT(12)
         COEF1= XMAT(11)*ALPH2 + XMAT(12)*PROCON(EPSV0,XX,NSTRS)
C             C = XMAT(13), C1 = XMAT(14)
         COEF2= (XMAT(13)-XMAT(14)*ALPH4)* PROCON(VAR(5),XX,NSTRS)
         CN = (2.0D0/3.0D0*COEF1 - COEF2)*1.5D0
         CX =XMAT(14)*ALPH4
C            C0 = XMAT(23), P1M0 = XMAT(24)
         IF (VAR(5+NSTRS).GT.XMAT(24)) THEN
              CX = CX + (XMAT(23)*(VAR(5+NSTRS)-XMAT(24)))
         ENDIF
       ENDIF
C
C---     PREPARATION DU CALCUL DE XPT = - COX.X
C             G= XMAT(15), R = XMAT(16)
       XII = SQRT(1.5D0*PROCON(VAR(5),VAR(5),NSTRS))
       COX = XMAT(15)*XPUISS(XII,XMAT(16)-1.0D0,AMAX)
C
C---      CALCUL DE XPM ET XPT
C        Cas ou PPT = 0  (et EPS0   aussi )
C        alors XPM = 0.0 convient
       DO 72 I=1,NSTRS,1
        VARPT(4+I) = - COX*VAR(4+I)
        IF (PPT.NE.0.0D0) THEN
          XPM (I) = CN*XX(I) - CX*VAR(4+I)
        ELSE
          XPM(I) = 0.0D0
        ENDIF
 72    CONTINUE
C
C-------  DERIVEES DE ALPH2 ET ALPH4 : VARPT(3) ET VARPT(4)
C              C2,Q,G1,R1,BHETA = XMAT(18..22)
C              P,P1,ALPH2,ALPH4 = VAR (1..4)
C      Chargement cyclique ?     si P1 &lt; P1M
       IF (VAR(2).LT.VAR(5+NSTRS)) THEN
         AN = XMAT(17)
         P1M = VAR (5+NSTRS)
         CO = XMAT(18)* (XMAT(19)*XPUISS(P1M,AN,AMAX)-ALPH2)* PPT
         VARPT(3) = CO - XMAT(20)*XPUISS(ALPH2,XMAT(21),AMAX)
         IF(VAR(1).LT.AMIN)
     .   WRITE(IOIMP,*) '   PROBLEME XXPT1 - VAR(1) = ',VAR(1)
         VARPT(4) = -XMAT(22)*PPT*ALPH4/(VAR(1)+AMIN)
       ELSE
         VARPT(3) = 0.0D0
         VARPT(4) = 0.0D0
       ENDIF
C
C------ CAS COQUE EPAISSE: RETOUR A 5 COMPOSANTES
C
       IF (MFR.EQ.5) THEN
          EPSVPT(1)=EPS0(1)
          EPSVPT(2)=EPS0(2)
          EPSVPT(3)=EPS0(4)
          EPSVPT(4)=EPS0(5)
          EPSVPT(5)=EPS0(6)
       ELSE
          DO 02 I=1,NSTRS
            EPSVPT(I)=EPS0(I)
 02       CONTINUE
       ENDIF
C
C------ ON RENTRE
       RETURN
       END