C CALIS2    SOURCE    CHAT      05/01/12    21:46:24     5004
      SUBROUTINE CALIS2(SHIST,NS,DSTN,IFOUB,SIR,CODU,CODL,
     &    COD,BETJEF,BETFLU)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C
      DIMENSION SHIST(4),SI1(4),SIR(8,4),CODL(8,8),COD(8),
     &          DH1(4,4),BRAN(8),DSTN(4),CODU(9,9),
     &          SIK(8,4),HIST(8,4),EXHU(9),EXHUL(8)
C
      SEGMENT BETJEF
       REAL*8 AA,BETA,FC,PALF,YOUN,XNU,GFC,GFT,CAR,ETA,TDEF,
     &          TCON,DPSTF1,DPSTF2,TETA,PDT,TP00
       INTEGER ICT,ICC,IMOD,IVIS,ITR,
     &                ISIM,IBB,IGAU,IZON
      ENDSEGMENT
C
      SEGMENT BETFLU
       REAL*8 DATCOU,DATCUR,DATSEC,E28,PGTZO,PGDUR,TAU1,TAU2,
     &         TP0,TZER
       INTEGER ITYPE,IFLU,NBRC,NCOE,NTZERO,NTPS,IFOR
      ENDSEGMENT
C
C*******************************************************************
C    Vérification du nombre d'entrées
C*******************************************************************
C
      STP1=TP0
      STP2=TP0+PDT
      EXH=0.D0
C
C*******************************************************************
C     CALCUL DES COEFFICIENTS DES BRANCHES DU MODELE DE MAXWELL
C*******************************************************************
C
      DO 10 N=1,NBRC
      IF (N.EQ.1) THEN
      BRAN(N)= TAU1
      ELSE
      BRAN(N)=10**(N-2)*TAU2
      ENDIF
   10 CONTINUE
C
C************************************************
C     CALCUL DES CONTRAINTES
C     DE CHAQUE BRANCHE DE MAXWELL
C     AU TEMPS TP0
C************************************************
C
C
      DO 11 K1 = 1,NS
      SHIST(K1) = 0.D0
      DO 12 K2 = 1,NBRC
      SIK(K2,K1) = 0.D0
      HIST(K2,K1) = 0.D0
   12 CONTINUE
   11 CONTINUE
C
C
C************************************************
C     SI IFLU DIFFERENT DE 0
C      ALORS IL Y A FLUAGE
C************************************************
C
C************************************************
C     Au premier incrément de temps  :
C     Pas de sigma historique
C************************************************
C
      IF (STP1.EQ.0.D0) THEN
      CALL MODBET(STP1,STP2,EI,EF,EXHU,EXHUL,EX,CODU,CODL,COD
     &      ,BETJEF,BETFLU)
C
      DO 20 I=1,NBRC
C
      EXH=EXHUL(I)
      CALL CREMAT(DH1,EXH,XNU,NS,IFOUB)
C
      CALL PROMA2(DH1,DSTN,3,SI1)
      DO 25 J=1,NS
      SIR(I,J)=SI1(J)
      HIST(I,J)=0.D0
   25 CONTINUE
C
   20 CONTINUE

      GOTO 500
C
C************************************************
      ELSE
C************************************************
C
      DO 30 I=1,NBRC
      DO 35 J=1,NS
C
      HIST(I,J)=SIR(I,J)*(EXP(-((STP2-STP1)
     */86400)/BRAN(I))-1)
C
   35 CONTINUE
   30 CONTINUE
C
C*************************************************
C     SOMMATION SUR LES CONTRAINTES
C     DE CHAQUE BRANCHE
C************************************************
C
      DO 40 J=1,NS
      DO 45 I=1,NBRC
C
      SHIST(J)=HIST(I,J)+SHIST(J)
   45 CONTINUE
   40 CONTINUE
C
      CALL MODBET(STP1,STP2,EI,EF,EXHU,EXHUL,EX,CODU,CODL,COD
     &      ,BETJEF,BETFLU)
C
      DO 50 I=1,NBRC
C
      EXH=EXHUL(I)
      CALL CREMAT(DH1,EXH,XNU,NS,IFOUB)
C
      CALL PROMA2(DH1,DSTN,3,SI1)
      DO 55 J=1,NS
      SIK(I,J)=SI1(J)
      SIR(I,J)=SIK(I,J)+HIST(I,J)+SIR(I,J)
   55 CONTINUE
C
   50 CONTINUE
      ENDIF
C
      RETURN
  500 END