Télécharger la plaquette Cast3M


fr en

Télécharger calpin.eso

Retour à la liste

Numérotation des lignes : 

calpin

  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