Télécharger la plaquette Cast3M


fr en

Télécharger calpec.eso

Retour à la liste

Numérotation des lignes : 

calpec

  1. C CALPEC    SOURCE    CB215821  16/04/21    21:15:30     8920
  2.       SUBROUTINE CALPEC(IFOU,STRN,SIGR,SIGM,S1,DEP,NSTRS,SEQC,
  3.      1 EBC,EPEQC,EPSR,STRNR,JFRIS,IPLA,EPEQ0,SEQ0,XE,NBNN,MELE,EQSTR1,
  4.      2 EPSEQ1,AA,BB,DK1,DK2,ILOI,RB,ALPHA,EX,PXY,EPO,wrk12)
  5. C
  6.       IMPLICIT INTEGER(I-N)
  7.       IMPLICIT REAL*8(A-H,O-Z)
  8.       DIMENSION STRNR(6),EPSR(6),SIGR(6),S(6)
  9.       DIMENSION S1(NSTRS),DFSI(6),STRN(NSTRS),DGSI(6)
  10.       DIMENSION DEP(NSTRS,NSTRS),D6(6,6),DP(6,6),S11(6)
  11.       DIMENSION SIGM(NSTRS),V1(4),SS(100,6),CR(100,3)
  12.       DIMENSION SI0(6),ST0(6),DST(6),DSI(6),XE(3,NBNN)
  13. C
  14.       SEGMENT WRK12
  15.       real*8  bbet1,bbet2,bbet3,bbet4,bbet5,bbet6,bbet7,bbet8,bbet9
  16.       real*8 bbet10,bbet11,bbet12,bbet13,bbet14,bbet15,bbet16,bbet17
  17.       real*8 bbet18,bbet19,bbet20,sct,teta,DTR1,dtr2,bbet25
  18.       real*8 bbet26,bbet27,bbet28,bbet29,bbet30,bbet31,bbet32,bbet33
  19.       real*8 bbet34,bbet35,bbet36,bbet37,bbet38,bbet39,bbet40,bbet41
  20.       real*8 bbet42,bbet43,bbet44,bbet45,bbet46,bbet47,bbet48,bbet49
  21.       real*8 bbet50,bbet51,bbet52,bbet53,bbet54,bbet55
  22.       integer ibet1,ibet2,ibet3,ibet4,ibet5,ibet6,ibet7,ibet8
  23.       integer ibet9,ibet10,ibet11,ibet12,ibet13,ibet14,ibet15,ibet16
  24.       ENDSEGMENT
  25.  
  26. *      COMMON /CINSA/ POUI(20),SCT,TETA,DTR1,DTR2,POUJ(31),IPOU(16)
  27. C-------------------------------------------------------------------
  28.       CALL ZERO(S1,NSTRS,1)
  29.       CALL ZERO(DEP,NSTRS,NSTRS)
  30. C
  31.       TU=RB
  32.       PRB=1.D-5
  33.       NIB=2
  34.       ICHOI=1
  35.       IPREM=0
  36. C-------------------------------------------------------------------
  37.       SCT =0.D0
  38.       DTR1=0.D0
  39.       DTR2=0.D0
  40.       TETA=0.D0
  42. C-------------------------------------------------------------------
  43.       BETC=EBC/EX
  44.       PAEC0=EBC/(1.D0-BETC)
  45.       CALL CRIOTO(SIGR,SEQ,FCRI,NSTRS,TU,AA,BB,DK1,DK2)
  46.       IF(SEQ.LT.1.D-10) IPREM=1
  47.       IF(SEQ.GT.TU) SEQ=TU
  48. C-------------------------------------------------------------------
  49.       DO 10 I=1,NSTRS
  50.          S11(I)=SIGR(I)+SIGM(I)
  51.          IF(IPREM.EQ.0) THEN
  52.            S1(I)=SIGR(I)
  53.          ELSE
  54.            S1(I)=S11(I)
  55.          ENDIF
  56.    10 CONTINUE
  57. C-------------------------------------------------------------------
  58.       IF(EPSEQ1.GE.EPO) THEN
  59. C   -------------------------------------------------------------
  60. C   *  ON  AVAIT DEJA DEPASSE LE PIC EN DEFORMATION EQUIVALENTE *
  61. C   -------------------------------------------------------------
  62.         CALL PRINC(SIGR,V1,NSTRS)
  63.         IF(V1(1).GE.0.D0) THEN
  64.           DTR1=V1(1)
  65.           DTR2=FPT
  66.           IF(DTR1.LT.0.D0)  DTR1=0.D0
  67.           IF(DTR1.GE.FPT)   DTR1=FPT
  68.           IF(DTR1.LT.1.D-8) DTR1=0.D0
  69.           TETA=V1(4)
  70.           DO 21 I=1,NSTRS
  71.             SI0(I)=SIGR(I)
  72.             ST0(I)=EPSR(I)
  73.             DSI(I)=SIGM(I)
  74.             DST(I)=STRN(I)
  75.    21     CONTINUE
  76.           JFRIS=2
  77.           IPLA=0
  78.           CALL FISPLA(ST0,DST,STRNR,SI0,DSI,S1,NSTRS,IFOU,0,XE,
  79.      1    NBNN,MELE,wrk12)
  80.           GOTO 200
  81.         ENDIF
  82.       ENDIF
  83. C-------------------------------------------------------------------
  84.       IF(IPREM.EQ.1) THEN
  85.         IF(NIB.EQ.1) NIB = 10
  86.         CALL CRIOTO(S1,SEQ,FCRI,NSTRS,TU,AA,BB,DK1,DK2)
  87.       ENDIF
  88. C-------------------------------------------------------------------
  89.       IF(IPREM.EQ.0.AND.SEQ.GT.TU) SEQ=TU
  90.       SEQ0=SEQ
  91.       IF(SEQ0.LT.1.D-8.AND.SEQC.LT.1.D-8) THEN
  92.         CALL ZERO(S1,NSTRS,1)
  93.         GOTO 200
  94.       ENDIF
  95.       IF(SEQ0.LT.1.D-8.AND.SEQC.GT.1.D-8) THEN
  96.         SEQ=SEQC
  97.       ENDIF
  98. C-------------------------------------------------------------------
  99.       CALL ZERO(CR,100,3)
  100.       CALL ZERO(SS,100,6)
  101. C-------------------------------------------------------------------
  102.       DO 1 II=1,NIB
  103. C-------------------------------------------------------------------
  104.       SEQ1=SEQ
  105.       IF(SEQ1.GT.TU) SEQ1=TU
  106.       IF(SEQ.LT.1.D-8) THEN
  107.         IPLA=4
  108.         GOTO 300
  109.       ENDIF
  110. C-------------------------------------------------------------------
  111. C         **************************************
  112. C         * BOUCLE SUR LES ITERATIONS INTERNES *
  113. C         **************************************
  114. C-------------------------------------------------------------------
  115.       CALL DFSIG(S1,DFSI,DGSI,SEQ1,NSTRS,RB,AA,BB,DK1,DK2,ILOI)
  116.       H2=0.D0
  117.       DO 92 I=1,NSTRS
  118.         H2=H2+DFSI(I)*DGSI(I)
  119.    92 CONTINUE
  120.       PAEC=PAEC0*H2
  121. C-------------------------------------------------------------------
  122.       CALL DEPO(S1,DEP,PAEC,SEQ1,NSTRS,IFOU,D6,DP,EX,PXY,AA,BB,
  123.      & DK1,DK2,RB,ILOI)
  124.       CALL BST(DEP,STRN,NSTRS,NSTRS,S)
  125.       DO 45 I=1,NSTRS
  126.         S1(I)=SIGR(I)+S(I)
  127.    45 CONTINUE
  128.       CALL CRIOTO(S1,SEQ,FCRI,NSTRS,SEQ1,AA,BB,DK1,DK2)
  129.       IF(SEQ.GT.SEQ0.AND.EPEQ0.GT.(1.1D0*EPO)) THEN
  130.         IPLA=4
  131.         GOTO 300
  132.       ENDIF
  133. C---------------------------------------------------------------------
  134.       IF(ABS(FCRI).LT.PRB) GOTO 7
  135.       DO 4 J=1,NSTRS
  136.          SS(II,J)=S1(J)
  137.     4 CONTINUE
  138.       CR(II,1)=FCRI
  139.       CR(II,2)=SEQ
  140.       CR(II,3)=PAEC
  141. C-------------------------------------------------------------------
  142. C         ************************************************
  143. C         * FIN DE LA BOUCLE SUR LES ITERATIONS INTERNES *
  144. C         ************************************************
  145.     1 CONTINUE
  146. c+mdj
  147. C      GOTO 7
  148. c+mdj
  149. C--------------------------------------------------------------------------
  150.       DMMN1=ABS(CR(1,1))
  151.       NO=1
  152.       DO 5 J=1,NIB
  153.        ACR=ABS(CR(J,1))
  154.        IF(DMMN1 .GE. ACR) THEN
  155.          DMMN1=ABS(CR(J,1))
  156.          NO=J
  157.        ENDIF
  158.     5 CONTINUE
  159.       DO 6 J=1,NSTRS
  160.         S1(J)=SS(NO,J)
  161.     6 CONTINUE
  162.         SEQ=CR(NO,2)
  163.         PAEC=CR(NO,3)
  164.     7 CONTINUE
  165. C----------------------------------------------------------------------
  166.       IF(SEQ.GT.TU) SEQ=TU
  167.       CALL DEPO(S1,DEP,PAEC,SEQ,NSTRS,IFOU,D6,DP,EX,PXY,AA,BB,
  168.      1 DK1,DK2,RB,ILOI)
  169. C-------------------------------------------------------------------
  170.       IF(SEQ.GT.EQSTR1) THEN
  171. C     -------------------------------------
  172.         DO  I=1,NSTRS
  173.            DSI(I)=S1(I)-SIGR(I)
  174.         END DO
  175.         CALL SCALT(DSI,SIGR,SI0,V1,SCT,NSTRS,DTAU,EQSTR1,AA,BB,DK1,
  176.      &  DK2,ALPHA,RB,DTR1,DTR2,TETA)
  177. C     -------------------------------------
  178.         IF(V1(1).GE.0.D0) THEN
  179.           DTR1=V1(1)
  180.           DTR2=FPT
  181.           TETA=V1(4)
  182.           IF(DTR1.LT.0.D0)  DTR1=0.D0
  183.           IF(DTR1.GE.FPT)   DTR1=FPT
  184.           IF(DTR1.LT.1.D-8) DTR1=0.D0
  185.           JFRIS=2
  186.           IPLA=0
  187.           CALL FISPLA(EPSR,STRN,STRNR,SIGR,DSI,S1,NSTRS,IFOU,0,XE,
  188.      1    NBNN,MELE,wrk12)
  189.          GOTO 200
  190.         ENDIF
  191. C     -------------------------------------
  192.         DTR1=0.D0
  193.         DTR1=0.D0
  194.         DTR1=0.D0
  195.         TETA=0.D0
  196.         SCT =0.D0
  197.         IPLA=4
  198. C     -------------------------------------
  199.       ENDIF
  200. C-------------------------------------------------------------------
  201.   300 CONTINUE
  202.       IF(IPLA.EQ.4) THEN
  203.         CALL ZERO(DEP,NSTRS,NSTRS)
  204.         CALL ZERO(S1,NSTRS,1)
  205.         EPSEQ1=EPEQC
  206.         EQSTR1=0.D0
  207.       ENDIF
  208. C-------------------------------------------------------------------
  209.   200 CONTINUE
  210. C---------------------------------------------------------------------
  211. 1991  FORMAT(18(1X,E12.5))
  212.       RETURN
  213.       END
  214.  
  215.  
  216.  
  217.  
  218.  
  219.  
  220.  
  221.  

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