C CALIS1    SOURCE    CHAT      05/01/12    21:46:21     5004
      SUBROUTINE CALIS1(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(9,4),CODL(8,8),COD(8),
     &          DH1(4,4),BRAN(8),DSTN(4),CODU(9,9),
     &          SIK(9,4),HIST(9,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
      MC=NBRC+1
      DO 5 N=1,NBRC
      IF (N.EQ.1) THEN
      BRAN(N)= TAU1
      ELSE
      BRAN(N)=10**(N-2)*TAU2
      ENDIF
    5 CONTINUE
C
C************************************************
C     CALCUL DES CONTRAINTES
C     DE CHAQUE BRANCHE DE MAXWELL
C     AU TEMPS TP0
C************************************************
C
C
C
C
      DO 10 J=1,NS
      DO 15 I=1,MC
      SIK(I,J)=0.D0
      HIST(I,J)=0.D0
   15 CONTINUE
      SHIST(J)=0.D0
   10 CONTINUE
C
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,MC
C
      EXH=EXHU(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,MC
      DO 35 J=1,NS
      IF (I.EQ.1) THEN
      HIST(I,J)=0
      ELSE
      HIST(I,J)=SIR(I,J)*(EXP(-((STP2-STP1)
     */86400)/BRAN(I-1))-1)
      ENDIF
   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,MC
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,MC
C
      EXH=EXHU(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