Télécharger calis1.eso

Retour à la liste

Numérotation des lignes :

  1. C CALIS1 SOURCE CHAT 05/01/12 21:46:21 5004
  2. SUBROUTINE CALIS1(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(9,4),CODL(8,8),COD(8),
  9. & DH1(4,4),BRAN(8),DSTN(4),CODU(9,9),
  10. & SIK(9,4),HIST(9,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. MC=NBRC+1
  38. DO 5 N=1,NBRC
  39. IF (N.EQ.1) THEN
  40. BRAN(N)= TAU1
  41. ELSE
  42. BRAN(N)=10**(N-2)*TAU2
  43. ENDIF
  44. 5 CONTINUE
  45. C
  46. C************************************************
  47. C CALCUL DES CONTRAINTES
  48. C DE CHAQUE BRANCHE DE MAXWELL
  49. C AU TEMPS TP0
  50. C************************************************
  51. C
  52. C
  53. C
  54. C
  55. DO 10 J=1,NS
  56. DO 15 I=1,MC
  57. SIK(I,J)=0.D0
  58. HIST(I,J)=0.D0
  59. 15 CONTINUE
  60. SHIST(J)=0.D0
  61. 10 CONTINUE
  62. C
  63. C
  64. C
  65. C************************************************
  66. C Au premier incrément de temps :
  67. C Pas de sigma historique
  68. C************************************************
  69. C
  70. 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,MC
  75. C
  76. EXH=EXHU(I)
  77. CALL CREMAT(DH1,EXH,XNU,NS,IFOUB)
  78. C
  79. CALL PROMA2(DH1,DSTN,3,SI1)
  80. DO 25 J=1,NS
  81. SIR(I,J)=SI1(J)
  82. HIST(I,J)=0.D0
  83. 25 CONTINUE
  84. C
  85. 20 CONTINUE
  86.  
  87. GOTO 500
  88. C
  89. C************************************************
  90. ELSE
  91. C************************************************
  92. C
  93. DO 30 I=1,MC
  94. DO 35 J=1,NS
  95. IF (I.EQ.1) THEN
  96. HIST(I,J)=0
  97. ELSE
  98. HIST(I,J)=SIR(I,J)*(EXP(-((STP2-STP1)
  99. */86400)/BRAN(I-1))-1)
  100. ENDIF
  101. 35 CONTINUE
  102. 30 CONTINUE
  103. C
  104. C*************************************************
  105. C SOMMATION SUR LES CONTRAINTES
  106. C DE CHAQUE BRANCHE
  107. C************************************************
  108. C
  109. DO 40 J=1,NS
  110. DO 45 I=1,MC
  111. C
  112. SHIST(J)=HIST(I,J)+SHIST(J)
  113. 45 CONTINUE
  114. 40 CONTINUE
  115. C
  116. CALL MODBET(STP1,STP2,EI,EF,EXHU,EXHUL,EX,CODU,CODL,COD
  117. & ,BETJEF,BETFLU)
  118. C
  119. DO 50 I=1,MC
  120. C
  121. EXH=EXHU(I)
  122. CALL CREMAT(DH1,EXH,XNU,NS,IFOUB)
  123. C
  124. CALL PROMA2(DH1,DSTN,3,SI1)
  125. DO 55 J=1,NS
  126. SIK(I,J)=SI1(J)
  127. SIR(I,J)=SIK(I,J)+HIST(I,J)+SIR(I,J)
  128. 55 CONTINUE
  129. C
  130. 50 CONTINUE
  131. ENDIF
  132. C
  133. RETURN
  134. 500 END
  135.  
  136.  
  137.  

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