Télécharger calpin.eso

Retour à la liste

Numérotation des lignes :

  1. C CALPIN SOURCE CB215821 16/04/21 21:15:30 8920
  2. C CALPIN SOURCE INSL 24/10/96
  3. SUBROUTINE CALPIN(IFOU,STRN,SIGM,SIGR,S1,DEP,NSTRS,EBC,
  4. 1 AA,BB,DK1,DK2,ILOI,RB,EX,PXY)
  5. C
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8(A-H,O-Z)
  8. DIMENSION S1(NSTRS),DFSI(6),STRN(NSTRS),DGSI(6),SIGR(NSTRS)
  9. DIMENSION DEP(NSTRS,NSTRS),D6(6,6),DP(6,6),S(6)
  10. DIMENSION SS(100,6),CR(100,3),SIGM(NSTRS)
  11. C-------------------------------------------------------------------
  12. C WRITE(*,*) '**** ON EST DANS CALPIN ******'
  13. C-------------------------------------------------------------------
  14. CALL ZERO(S1,NSTRS,1)
  15. CALL ZERO(DEP,NSTRS,NSTRS)
  16. C-------------------------------------------------------------------
  17. TU=RB
  18. PRB=1.D-5
  19. NIB=2
  20. ICHOI=1
  21. IPREM=0
  22. C-------------------------------------------------------------------
  23. BETC=EBC/EX
  24. C-------------------------------------------------------------------
  25. PAEC0=EBC/(1.D0-BETC)
  26. CALL CRIOTO(SIGR,SEQ,FCRI,NSTRS,TU,AA,BB,DK1,DK2)
  27. IF(SEQ.LT.1.D-10) IPREM=1
  28. IF(SEQ.GT.TU) SEQ=TU
  29. C-------------------------------------------------------------------
  30. DO 10 I=1,NSTRS
  31. IF(IPREM.EQ.0) THEN
  32. S1(I)=SIGR(I)
  33. ELSE
  34. S1(I)=SIGR(I)+SIGM(I)
  35. ENDIF
  36. 10 CONTINUE
  37. C-------------------------------------------------------------------
  38. IF(IPREM.EQ.1) THEN
  39. IF(NIB.EQ.1) NIB = 10
  40. CALL CRIOTO(S1,SEQ,FCRI,NSTRS,TU,AA,BB,DK1,DK2)
  41. ENDIF
  42. C-------------------------------------------------------------------
  43. SEQ0=SEQ
  44. CALL ZERO(CR,100,3)
  45. CALL ZERO(SS,100,6)
  46. C-------------------------------------------------------------------
  47. DO 1 II=1,NIB
  48. SEQ1=SEQ
  49. C-------------------------------------------------------------------
  50. C **************************************
  51. C * BOUCLE SUR LES ITERATIONS INTERNES *
  52. C **************************************
  53. C-------------------------------------------------------------------
  54. IF(SEQ.LT.1.D-10) THEN
  55. CALL ZERO(DEP,NSTRS,NSTRS)
  56. GOTO 40
  57. ENDIF
  58. CALL DFSIG(S1,DFSI,DGSI,SEQ1,NSTRS,RB,AA,BB,DK1,DK2,ILOI)
  59. H2=0.D0
  60. DO 92 I=1,NSTRS
  61. H2=H2+DFSI(I)*DGSI(I)
  62. 92 CONTINUE
  63. PAEC=PAEC0*H2
  64. C-------------------------------------------------------------------
  65. CALL DEPO(S1,DEP,PAEC,SEQ1,NSTRS,IFOU,D6,DP,EX,PXY,AA,BB,
  66. & DK1,DK2,RB,ILOI)
  67. C-------------------------------------------------------------------
  68. 40 CONTINUE
  69. CALL BST(DEP,STRN,NSTRS,NSTRS,S)
  70. DO 45 I=1,NSTRS
  71. S1(I)=SIGR(I)+S(I)
  72. 45 CONTINUE
  73. CALL CRIOTO(S1,SEQ,FCRI,NSTRS,SEQ1,AA,BB,DK1,DK2)
  74. C---------------------------------------------------------------------
  75. IF(ABS(FCRI).LT.PRB) GOTO 7
  76. DO 4 J=1,NSTRS
  77. SS(II,J)=S1(J)
  78. 4 CONTINUE
  79. CR(II,1)=FCRI
  80. CR(II,2)=SEQ
  81. CR(II,3)=PAEC
  82. C-------------------------------------------------------------------
  83. C ************************************************
  84. C * FIN DE LA BOUCLE SUR LES ITERATIONS INTERNES *
  85. C ************************************************
  86. 1 CONTINUE
  87. C--------------------------------------------------------------------------
  88. DMMN1=ABS(CR(1,1))
  89. NO=1
  90. DO 5 J=1,NIB
  91. ACR=ABS(CR(J,1))
  92. IF(DMMN1 .GE. ACR) THEN
  93. DMMN1=ABS(CR(J,1))
  94. NO=J
  95. ENDIF
  96. 5 CONTINUE
  97. DO 6 J=1,NSTRS
  98. S1(J)=SS(NO,J)
  99. IF(ABS(S1(I)).LT.1.D-8) S1(I)=0.D0
  100. 6 CONTINUE
  101. SEQ=CR(NO,2)
  102. PAEC=CR(NO,3)
  103. 7 CONTINUE
  104. C----------------------------------------------------------------------
  105. IF(SEQ.GT.TU) SEQ=TU
  106. CALL DEPO(S1,DEP,PAEC,SEQ,NSTRS,IFOU,D6,DP,EX,PXY,AA,BB,
  107. 1 DK1,DK2,RB,ILOI)
  108. C--------------------------------------------------------------------------
  109. 200 CONTINUE
  110. C--------------------------------------------------------------------------
  111. 1991 FORMAT(18(1X,E12.5))
  112. C--------------------------------------------------------------------------
  113. RETURN
  114. END
  115.  
  116.  
  117.  
  118.  
  119.  

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