Télécharger la plaquette Cast3M


fr en

Télécharger calis2.eso

Retour à la liste

Numérotation des lignes : 

calis2

  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
  72.       CALL MODBET(STP1,STP2,EI,EF,EXHU,EXHUL,EX,CODU,CODL,COD
  73.      &      ,BETJEF,BETFLU)
  74. C
  75.       DO 20 I=1,NBRC
  76. C
  77.       EXH=EXHUL(I)
  78.       CALL CREMAT(DH1,EXH,XNU,NS,IFOUB)
  79. C
  80.       CALL PROMA2(DH1,DSTN,3,SI1)
  81.       DO 25 J=1,NS
  82.       SIR(I,J)=SI1(J)
  83.       HIST(I,J)=0.D0
  84.    25 CONTINUE
  85. C
  86.    20 CONTINUE
  87.  
  88.       GOTO 500
  89. C
  90. C************************************************
  91.       ELSE
  92. C************************************************
  93. C
  94.       DO 30 I=1,NBRC
  95.       DO 35 J=1,NS
  96. C
  97.       HIST(I,J)=SIR(I,J)*(EXP(-((STP2-STP1)
  98.      */86400)/BRAN(I))-1)
  99. C
  100.    35 CONTINUE
  101.    30 CONTINUE
  102. C
  103. C*************************************************
  104. C     SOMMATION SUR LES CONTRAINTES
  105. C     DE CHAQUE BRANCHE
  106. C************************************************
  107. C
  108.       DO 40 J=1,NS
  109.       DO 45 I=1,NBRC
  110. C
  111.       SHIST(J)=HIST(I,J)+SHIST(J)
  112.    45 CONTINUE
  113.    40 CONTINUE
  114. C
  115.       CALL MODBET(STP1,STP2,EI,EF,EXHU,EXHUL,EX,CODU,CODL,COD
  116.      &      ,BETJEF,BETFLU)
  117. C
  118.       DO 50 I=1,NBRC
  119. C
  120.       EXH=EXHUL(I)
  121.       CALL CREMAT(DH1,EXH,XNU,NS,IFOUB)
  122. C
  123.       CALL PROMA2(DH1,DSTN,3,SI1)
  124.       DO 55 J=1,NS
  125.       SIK(I,J)=SI1(J)
  126.       SIR(I,J)=SIK(I,J)+HIST(I,J)+SIR(I,J)
  127.    55 CONTINUE
  128. C
  129.    50 CONTINUE
  130.       ENDIF
  131. C
  132.       RETURN
  133.   500 END
  134.  
  135.  
  136.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales