Esope source files

   1 : C CALIS2    SOURCE    CHAT      05/01/12    21:46:24     5004           
   2 :       SUBROUTINE CALIS2(SHIST,NS,DSTN,IFOUB,SIR,CODU,CODL,
   3 :      &    COD,BETJEF,BETFLU)
   4 : C
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8(A-H,O-Z)
   7 : C
   8 :       DIMENSION SHIST(4),SI1(4),SIR(8,4),CODL(8,8),COD(8),
   9 :      &          DH1(4,4),BRAN(8),DSTN(4),CODU(9,9),
  10 :      &          SIK(8,4),HIST(8,4),EXHU(9),EXHUL(8)
  11 : C
  12 :       SEGMENT BETJEF
  13 :        REAL*8 AA,BETA,FC,PALF,YOUN,XNU,GFC,GFT,CAR,ETA,TDEF,
  14 :      &          TCON,DPSTF1,DPSTF2,TETA,PDT,TP00
  15 :        INTEGER ICT,ICC,IMOD,IVIS,ITR,
  16 :      &                ISIM,IBB,IGAU,IZON
  17 :       ENDSEGMENT
  18 : C
  19 :       SEGMENT BETFLU
  20 :        REAL*8 DATCOU,DATCUR,DATSEC,E28,PGTZO,PGDUR,TAU1,TAU2,
  21 :      &         TP0,TZER
  22 :        INTEGER ITYPE,IFLU,NBRC,NCOE,NTZERO,NTPS,IFOR
  23 :       ENDSEGMENT
  24 : C
  25 : C*******************************************************************
  26 : C    Vérification du nombre d'entrées
  27 : C*******************************************************************
  28 : C
  29 :       STP1=TP0
  30 :       STP2=TP0+PDT
  31 :       EXH=0.D0
  32 : C
  33 : C*******************************************************************
  34 : C     CALCUL DES COEFFICIENTS DES BRANCHES DU MODELE DE MAXWELL
  35 : C*******************************************************************
  36 : C
  37 :       DO 10 N=1,NBRC
  38 :       IF (N.EQ.1) THEN
  39 :       BRAN(N)= TAU1
  40 :       ELSE
  41 :       BRAN(N)=10**(N-2)*TAU2
  42 :       ENDIF
  43 :    10 CONTINUE
  44 : C
  45 : C************************************************
  46 : C     CALCUL DES CONTRAINTES 
  47 : C     DE CHAQUE BRANCHE DE MAXWELL
  48 : C     AU TEMPS TP0
  49 : C************************************************
  50 : C
  51 : C
  52 :       DO 11 K1 = 1,NS
  53 :       SHIST(K1) = 0.D0
  54 :       DO 12 K2 = 1,NBRC
  55 :       SIK(K2,K1) = 0.D0
  56 :       HIST(K2,K1) = 0.D0
  57 :    12 CONTINUE
  58 :    11 CONTINUE
  59 : C
  60 : C      
  61 : C************************************************
  62 : C     SI IFLU DIFFERENT DE 0 
  63 : C      ALORS IL Y A FLUAGE
  64 : C************************************************
  65 : C
  66 : C************************************************
  67 : C     Au premier incrément de temps  : 
  68 : C     Pas de sigma historique
  69 : C************************************************
  70 : C
  71 :       IF (STP1.EQ.0.D0) THEN
  71 :       CALL MODBET(STP1,STP2,EI,EF,EXHU,EXHUL,EX,CODU,CODL,COD
  72 :      &      ,BETJEF,BETFLU)
  73 : C      
  74 :       DO 20 I=1,NBRC
  75 : C     
  76 :       EXH=EXHUL(I) 
  76 :       CALL CREMAT(DH1,EXH,XNU,NS,IFOUB)
  77 : C      
  77 :       CALL PROMA2(DH1,DSTN,3,SI1)
  78 :       DO 25 J=1,NS
  79 :       SIR(I,J)=SI1(J)
  80 :       HIST(I,J)=0.D0
  81 :    25 CONTINUE
  82 : C
  83 :    20 CONTINUE
  84 :    
  85 :       GOTO 500
  86 : C
  87 : C************************************************   
  88 :       ELSE
  89 : C************************************************
  90 : C
  91 :       DO 30 I=1,NBRC
  92 :       DO 35 J=1,NS
  93 : C      
  94 :       HIST(I,J)=SIR(I,J)*(EXP(-((STP2-STP1)
  95 :      */86400)/BRAN(I))-1)
  96 : C     
  97 :    35 CONTINUE
  98 :    30 CONTINUE
  99 : C
 100 : C*************************************************
 101 : C     SOMMATION SUR LES CONTRAINTES 
 102 : C     DE CHAQUE BRANCHE
 103 : C************************************************      
 104 : C
 105 :       DO 40 J=1,NS
 106 :       DO 45 I=1,NBRC 
 107 : C
 108 :       SHIST(J)=HIST(I,J)+SHIST(J)
 109 :    45 CONTINUE
 110 :    40 CONTINUE
 111 : C       
 111 :       CALL MODBET(STP1,STP2,EI,EF,EXHU,EXHUL,EX,CODU,CODL,COD
 112 :      &      ,BETJEF,BETFLU)
 113 : C      
 114 :       DO 50 I=1,NBRC
 115 : C      
 116 :       EXH=EXHUL(I)
 116 :       CALL CREMAT(DH1,EXH,XNU,NS,IFOUB)
 117 : C      
 117 :       CALL PROMA2(DH1,DSTN,3,SI1)
 118 :       DO 55 J=1,NS
 119 :       SIK(I,J)=SI1(J)
 120 :       SIR(I,J)=SIK(I,J)+HIST(I,J)+SIR(I,J)
 121 :    55 CONTINUE
 122 : C
 123 :    50 CONTINUE
 124 :       ENDIF
 125 : C               
 126 :       RETURN
 127 :   500 END
 128 :  
 129 :