Télécharger la plaquette Cast3M


fr en

Télécharger chaflu.eso

Retour à la liste

Numérotation des lignes : 

chaflu

  1. C CHAFLU    SOURCE    CHAT      05/01/12    21:54:10     5004
  2.       SUBROUTINE CHAFLU(YUNG,XNU,IA,EI,SSTAR,
  3.      1 XMAT,ALPHA1,IBOU,SI,DEPS,EPST,EPSTAR,AMTRI,
  4.      2 ALPHA2,DPSM1,DPSM2,KERRE,NUMCHA,ecou,necou)
  5. C
  6. C            INTEGRATION MODELE DE CHABOCHE  EN FLUAGE
  7. C
  8.       IMPLICIT INTEGER(I-N)
  9.       IMPLICIT REAL *8(A-H,O-Z)
  10.       DIMENSION XMAT(*),EI(*),ALPHA1(*),ALPHA2(*)
  11.       DIMENSION AMTRI(18,7),DELT(6)
  12. C
  13. *  Commun ECOU: sert de fourre-tout pour les tableaux
  14. *
  15.       SEGMENT ECOU
  16. ***     COMMON/ECOU/TEST,ALFAH,
  17.        REAL*8 TEST, ALFAH,
  18.      1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
  19.      2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6),
  20.      1 DALPHA(6),DSIGO(6),E(12),XINV(3),
  21.      2 SIPLAD(6),DSIGP0(6),TET,TETI
  22.       ENDSEGMENT
  23.  
  24. C      COMMON/ECOU/TEST,ALFAH,
  25. C     1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
  26. C     2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6),
  27. C     1 DALPHA(6),DSIGO(6),E(12),XINV(3),
  28. C     2 SIPLAD(6),DSIGP0(6),TET,TETI
  29. C
  30.  
  31. *  Commun NECOU utilisé dans ECOINC
  32. *
  33.       SEGMENT NECOU
  34. *      COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  35.        INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  36.      . ITYP,IFOUR,IFLUAG,
  37.      . ICINE,ITHER,IFLUPL,ICYCL,IBI,
  38.      . JFLUAG,KFLUAG,LFLUAG,
  39.      . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
  40.       ENDSEGMENT
  41. C      COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  42. C     . ITYP,IFOUR,IFLUAG,
  43. C     . ICINE,ITHER,IFLUPL,ICYCL,IBI,
  44. C     . JFLUAG,KFLUAG,LFLUAG,
  45. C     . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
  46. C
  47. C  JFLUAG = 1  ON FLUE AVEC SIGMA ET ON RECUPERE SIGMA EN ENTREE
  48. C  JFLUAG = 2  ON FLUE AVEC (SIG-X) ET ON RECUPERE (SIG-X) EN ENTREE
  49. C  LFLUAG = 0  ON ECROUIT EN CAS DE FLUAGE
  50. C  LFLUAG = 1  ON N'ECROUIT PAS EN CAS DE FLUAGE
  51. C
  52.       IFLU=0
  53.       IF(JFLUAG.GT.1.AND.LFLUAG.EQ.0) IFLU=1
  54. C
  55.       A2=0.
  56.       C2=0.
  57.       B=0.
  58.       PHI=1.D00
  59.       ICOD=0
  60.       CALL CHALIM(EPSTAR,R,XMAT,TET,ICOD,A1,C1,A2,C2,R0,RM,B,
  61.      . PHI,PSI,OME,ICENT2,IDIAM,NUMCHA)
  62.       ELT=YUNG/(1.+XNU)
  63.       IF(ITHER.NE.0) ELT=ELT*EI(IA)/YUNG
  64.       G=ELT*0.5
  65.       SAC1=A1*C1*PHI
  66.       AC1=SAC1*0.66666667
  67.       SAC2=A2*C2*PHI
  68.       AC2=SAC2*0.66666667
  69.       SAC12=SAC1+SAC2
  70.       AC12=AC1+AC2
  71.       GO TO (101,102,103,104,105,103,107,104,109,999,999,999,
  72.      .       103,101),ITYP
  73. 101   NPLEIN=3
  74.       IBO=1
  75.       E(1)=ELT+AC12*IFLU
  76.       E(2)=-0.5*E(1)
  77.       E(3)=1.5*E(1)
  78.       E(4)=-AC1
  79.       E(5)=0.5*AC1
  80.       E(6)=-1.5*AC1
  81.       IF(ICENT2.EQ.0) GO TO 200
  82.       E(7)=-AC2
  83.       E(8)=0.5*AC2
  84.       E(9)=-1.5*AC2
  85.       GO TO 200
  86. 102   IBO=2
  87.       GO TO 121
  88. 103   IBO=1
  89. 121   NPLEIN=2
  90.       E(1)=G*(2.-XNU)/(1.-XNU)+SAC12*IFLU
  91.       E(2)=G*(2.*XNU-1.)/(1.-XNU)
  92.       E(3)=1.5*(ELT+AC12*IFLU)
  93.       E(4)=-SAC1
  94.       E(5)=0.
  95.       E(6)=-SAC1
  96.       IF(ICENT2.EQ.0) GO TO 200
  97.       E(7)=-SAC2
  98.       E(8)=0.
  99.       E(9)=-SAC2
  100.       GO TO 200
  101. 104   IBO=1
  102.       GO TO 125
  103. 107   IBO=2
  104. 125   DUM=YUNG
  105.       NPLEIN=1
  106.       IF(ITHER.NE.0) DUM=DUM*EI(IA)/YUNG
  107.       DUM=DUM+SAC12*IFLU
  108.       E(1)=DUM
  109.       E(4)=-SAC1
  110.       IF(ICENT2.NE.0) E(7)=-SAC2
  111.       GO TO 200
  112. 105   CONTINUE
  113. 109   CONTINUE
  114. 200   IBOU1=IBOU+1
  115.       TAUX=0.
  116.       TIME=TEMPS-HPAS
  117.       ICLFLU=0
  118.       IF(IT.NE.1) GO TO 201
  119. C
  120. C  MODIFS POUR LA 1-ERE ITERATION
  121. C  ECOULEMENT SELON SIGMA
  122. C
  123.       S0=VONMIS(SIGEL,ITYP,ALFAH,COVNMS)
  124.       CALL CRPLAW(VI0,EPSTAR,S0,TET,TIME,HPAS,ICLFLU,NCOURB)
  125.       DPSM1=VI0
  126.       EPST=EPSTAR+HPAS*VI0
  127.       CALL CRPLAW(VIF,EPST,SSTAR,TET,TEMPS,HPAS,ICLFLU,NCOURB)
  128.       DPSM2=SSTAR
  129.       SF=SSTAR
  130.       DEPS=(VI0+VIF)*0.5D0*HPAS
  131.       EPST=EPSTAR+DEPS
  132. C
  133. C  TEST POUR LES CAS DE FLUAGE A SIGMA NON CTE ET AVEC SEUIL
  134. C
  135.       IF(DEPS.EQ.0.) GO TO 1380
  136.       DEPSUR=0.
  137.       IF(SF.NE.0.) DEPSUR=DEPS/SF
  138.       CALL CHAINI(AMTRI,18,IBOU,NPLEIN,E,DEPSUR,IBO)
  139.       IF(IFLU.EQ.0) GO TO 1531
  140.       CALL CHAINI(AMTRI(IBOU1,1),18,IBOU,NPLEIN,E(4),DEPSUR,IBO)
  141.       IF(ICENT2.EQ.1) CALL CHAINI(AMTRI(IBOU1+IBOU,1),18,IBOU,
  142.      . NPLEIN,E(7),DEPSUR,IBO)
  143.       DO 1334 IB=1,IBOU
  144.       AMTRI(IB,7)=0.D0
  145.       IB1=IB+IBOU
  146.       IF(ICENT2.NE.0) GO TO 1335
  147.       AMTRI(IB1,7)=ALPHA1(IB)
  148.       GO TO 1334
  149. 1335  AMTRI(IB1,7)=ALPHA1(IB)-ALPHA2(IB)
  150.       AMTRI(IB1+IBOU,7)=ALPHA2(IB)
  151. 1334  CONTINUE
  152.       CALL CHAMAT(AMTRI,AMTRI(1,7),18,NPLEIN,IBOU,ICENT2,
  153.      . C1,C2,DEPS,IBO,IFLU,1,LFLUAG,KERRE)
  154.       IF(KERRE.NE.0) RETURN
  155.       DO 1532 I=1,IBOU
  156.       DSIGP(I)=-AMTRI(I,7)
  157.       DO 1533 J=1,IBOU
  158. 1533  DSIGP(I)=DSIGP(I)+AMTRI(I,J)*SIGEL(J)
  159. 1532  STOT(I)=SIGEL(I)+DSIGP(I)
  160.       GO TO 222
  161. 1531  DO 304 I=1,IBOU
  162.       DSIGP(I)=0.
  163.       DO 305 J=1,IBOU
  164. 305   DSIGP(I)=DSIGP(I)+AMTRI(I,J)*SIGEL(J)
  165. 304   STOT(I)=SIGEL(I)+DSIGP(I)
  166.       GO TO 221
  167. 201   CONTINUE
  168.       VI0=DPSM1
  169.       SF=DPSM2
  170.       EPST=EPSTAR+HPAS*VI0
  171.       CALL CRPLAW(VIF,EPST,SF,TET,TEMPS,HPAS,ICLFLU,NCOURB)
  172.       DEPS=(VI0+VIF)*0.5*HPAS
  173.       EPST=EPSTAR+DEPS
  174. 1380  CONTINUE
  175.       DEPSUR=0.
  176.       IF(SF.NE.0.) DEPSUR=DEPS/SF
  177. 222   CALL CHAINI(AMTRI,18,IBOU,NPLEIN,E,DEPSUR,IBO)
  178. 221   IF(LFLUAG.EQ.1) GO TO 1240
  179.       CALL CHAINI(AMTRI(IBOU1,1),18,IBOU,NPLEIN,E(4),DEPSUR,IBO)
  180.       IF(ICENT2.EQ.1) CALL CHAINI(AMTRI(IBOU1+IBOU,1),18,IBOU,
  181.      .  NPLEIN,E(7),DEPSUR,IBO)
  182. 1240  DO 202 I=1,IBOU
  183. 202   AMTRI(I,I)=AMTRI(I,I)+1.
  184. C
  185. C  SECOND MEMBRE
  186. C
  187.       DO 134 IB=1,IBOU
  188.       AMTRI(IB,7)=STOT(IB)
  189.       IF(LFLUAG.EQ.1) GO TO 134
  190.       IB1=IB+IBOU
  191.       IF(ICENT2.NE.0) GO TO 135
  192.       AMTRI(IB1,7)=ALPHA1(IB)
  193.       GO TO 134
  194. 135   AMTRI(IB1,7)=ALPHA1(IB)-ALPHA2(IB)
  195.       AMTRI(IB1+IBOU,7)=ALPHA2(IB)
  196. 134   CONTINUE
  197.       CALL CHAMAT(AMTRI,AMTRI(1,7),18,NPLEIN,IBOU,ICENT2,C1,C2,
  198.      .  DEPS,IBO,IFLU,0,LFLUAG,KERRE)
  199.       IF(KERRE.NE.0) RETURN
  200. 300   SI=VONMIS(AMTRI(1,7),ITYP,ALFAH,COVNMS)
  201.       DPSM2=SI
  202.       DO 301 I=1,IBOU
  203.       SIGEL(I)=AMTRI(I,7)
  204.       IF(LFLUAG.EQ.1) GO TO 301
  205.       DALPHA(I)=AMTRI(IBOU+I,7)-ALPHA1(I)
  206.       IF(ICENT2.EQ.0) GO TO 301
  207.       DALPHA(I)=DALPHA(I)+AMTRI(IBOU+IBOU+I,7)
  208. 301   CONTINUE
  209. C
  210. C  LES DEUX CENTRES SONT CUMULES DANS ALPHA1
  211. C
  212.       IF(LFLUAG.EQ.1) RETURN
  213. C
  214. C   MISE A JOUR DES CENTRES DES SPHERES
  215. C
  216.       DO 303 I=1,IBOU
  217.       ALPHA1(I)=AMTRI(IBOU+I,7)
  218.       IF(ICENT2.EQ.0) GO TO 303
  219.       ALPHA1(I)=ALPHA1(I)+AMTRI(IBOU+IBOU+I,7)
  220.       ALPHA2(I)=AMTRI(IBOU+IBOU+I,7)
  221. 303   CONTINUE
  222.       RETURN
  223. 999   WRITE(6,7999)
  224. 7999  FORMAT('0 CHAFLU - CAS NON IMPLEMENTE ' /)
  225.       RETURN
  226.       END
  227.  
  228.  
  229.  
  230.  
  231.  
  232.  
  233.  

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