Télécharger la plaquette Cast3M


fr en

Télécharger cflun2.eso

Retour à la liste

Numérotation des lignes : 

cflun2

  1. C CFLUN2    SOURCE    PV        22/04/22    21:15:06     11344          
  2.       SUBROUTINE CFLUN2(wrk52,wrk53,wrk54,wrk2,wrk3,
  3.      &  IB,IGAU,NBPGAU,NBGMAT,NELMAT,IFOURB)
  4. *
  5. * modele fluage type Norton dep/dt = C sig^n t^m
  6. * traite sigf = sig0 + k (deps - dep)
  7. * on pourrait separer deviateur et terme spherique
  8. *
  9.       IMPLICIT INTEGER(I-N)
  10.       IMPLICIT REAL*8 (A-H,O-Z)
  11.  
  12. -INC PPARAM
  13. -INC CCOPTIO
  14. -INC DECHE
  15. -INC SMLREEL
  16. -INC SMEVOLL
  17. *
  18. *
  19. *
  20.       SEGMENT WRK2
  21.         REAL*8 TRAC(LTRAC)
  22.       ENDSEGMENT
  23. *
  24.       SEGMENT WRK3
  25.         REAL*8 WORK(LW),WORK2(LW2)
  26.       ENDSEGMENT
  27. *
  28.       dimension spri0(8),delep0(8),spri1(8),delep1(8),
  29.      &DIV(8),CRIGI(12)
  30.  
  31.  
  32.  
  33. * cas isotrope
  34.       ip1 = 4
  35. *
  36.       youn0 = xmat0(1)
  37.       sigy0 = xmat0(ip1+1)
  38.       xc0 = xmat0(ip1+2)
  39.       xn0 = xmat0(ip1+3)
  40.       xm0 = xmat0(ip1+4)
  41.       ips0 = int(xmat0(ip1+5))
  42.       ipe0 = int(xmat0(ip1+6))
  43.         x2mu0= xmat0(1)/(1.+xmat0(2))
  44.  
  45.  
  46.        if(ib.eq.1.and.igau.eq.1) then
  47. *        write(6,*) 't0' , youn0, sigy0, xn0 ,xm0 ,gk0,pk0
  48.        endif
  49.  
  50.       youn1 = xmat(1)
  51.       sigy1 = xmat(ip1+1)
  52.       xc1 = xmat(ip1+2)
  53.       xn1 = xmat(ip1+3)
  54.       xm1 = xmat(ip1+4)
  55.       ips1 = int(xmat(ip1+5))
  56.       ipe1 = int(xmat(ip1+6))
  57.         x2mu1= xmat(1)/(1.+xmat(2))
  58.  
  59.        if(ib.eq.1.and.igau.eq.1) then
  60. *      write(6,*) 't1' ,ips1,ipe1
  61.        endif
  62. *
  63.       delt = tempf - temp0
  64.       if (delt.lt.0..or.tempf.lt.0.) then
  65.          moterr(1:16) = conm
  66.          moterr(17:24) = 'CFLUN2-5'
  67.          call erreur(943)
  68.          return
  69.        endif
  70.  
  71. C---------CARACTERISTIQUES GEOMETRIQUES---------------------------------
  72. C
  73. C         COQUES
  74. C
  75.       ALFAH=1.D0
  76.       IF(MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  77.         EP1=work(1)
  78.         IF(MFR.NE.5) ALFAH=work(2)**2
  79.       ENDIF
  80. C---------COQUES AVEC CT------------------------------------------------
  81. C         ON NE TRAVAILLE QUE SUR LES 6 PREMIERES COMPOSANTES
  82.  
  83.       IF(MFR.EQ.9) THEN
  84.         NCONT=6
  85.       ELSE
  86.         NCONT=NSTRS
  87.       ENDIF
  88.  
  89. * calcul increments de contrainte
  90. * remarque on utilise les caracteristiques elastiques a la date finale
  91.  
  92.       CALL CALSIG(depst,DDAUX,NSTAUX,CMATE,VALMAT,VALCAR,
  93.      &        N2EL,N2PTEL,MFR,IFOURB,IB,IGAU,EPAIST,
  94.      &      NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,
  95.      &    XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,dsigt,IRTD)
  96.  
  97.       IF(IRTD.NE.1) THEN
  98.          KERRE=69
  99.          GOTO 1010
  100.       ENDIF
  101.  
  102. * determine direction et sens de sigf et eflu
  103.  
  104.       DO I=1,NSTRS
  105.         DSIGT(I)=SIG0(I) + dsigt(i)
  106.       ENDDO
  107.  
  108. C---------CAS DES POUTRES-----------------------------------------------
  109.  
  110.       IF(MFR.EQ.7) THEN
  111.         DIV(1)=1.D0/work(4)
  112.         DIV(2)=1.D0
  113.         DIV(3)=1.D0
  114.         DIV(4)=work(10)/work(1)
  115.         DIV(5)=work(11)/work(2)
  116.         DIV(6)=work(12)/work(3)
  117.         IF(DIV(4).EQ.0.D0) DIV(4)=1.D-10/SQRT(work(1)*work(4))
  118.         IF(DIV(5).EQ.0.D0) DIV(5)=1.D-10/SQRT(work(2)*work(4))
  119.         IF(DIV(6).EQ.0.D0) DIV(6)=1.D-10/SQRT(work(3)*work(4))
  120.         DO I=1,NCONT
  121.            DSIGT(I)= DSIGT(I)*DIV(I)
  122.         ENDDO
  123.       ENDIF
  124. *
  125. * raisonne en deviateur
  126.       trsig0 = (dsigt(1) + dsigt(2) + dsigt(3)) * 0.33333333333d0
  127.       spri0(1) = dsigt(1) - trsig0
  128.       spri0(2) = dsigt(2) - trsig0
  129.       spri0(3) = dsigt(3) - trsig0
  130.       do is = 4,nstrs
  131.         spri0(is) = dsigt(is)
  132.       enddo
  133.  
  134. C-----------------------------------------------------------------------
  135. C         CALCUL DE LA CONTRAINTE EQUIVALENTE SEQ
  136. C-----------------------------------------------------------------------
  137.       seqtot=VONMIS0(spri0,NSTRS,MFR,IFOURB,EP1,ALFAH)
  138.  
  139.       if (seqtot - sigy1.gt.0.) then
  140.         seq0 = seqtot
  141.       else
  142. * pas de termes inelastiques
  143.         do ic = 1,nstrs
  144.           sigf(ic) = dsigt(ic)
  145.         enddo
  146.         varf(1) = var0(1)
  147.         varf(2) = var0(2)
  148.         goto 1002
  149.         return
  150.       endif
  151.  
  152.        if (xn1.ge.0..and.xc1.ge.0..and.xm1.ge.0..AND.x2mu1.ge.0.) then
  153.        else
  154.          moterr(1:16) = conm
  155.          moterr(17:24) = 'CFLUEN-1'
  156. c         write(6,*) xn1,xc1,xm1,x2mu1
  157.          call erreur(943)
  158.          return
  159.        endif
  160.  
  161. * point fixe pour determiner le multiplicateur de sigtot/seqtot
  162.       icaz = 1
  163.       do ipfx = 1,50
  164.          if(ib.eq.1.and.igau.eq.1) then
  165. c            write(6,*) 'pt fixe' , ipfx, seq0,seqtot,icaz
  166.          endif
  167.          goto (70,80) icaz
  168.  70    continue
  169. * fonction
  170.           delr0 = (seq0 ** xn1) * (tempf ** xm1)
  171.           xmult = delr0 * xc1  * delt * x2mu1
  172.         seq01 =  seqtot - xmult
  173.        goto 90
  174.  
  175. * fonction associee
  176.   80   continue
  177.          xmult = seqtot - seq0
  178.         delr0 = xmult / delt/xc1 / (tempf ** xm1) / x2mu1
  179.         seq01 = delr0 ** (1/xn1)
  180.        goto 90
  181.  
  182.  90    continue
  183.         if(ib.eq.1.and.igau.eq.1) then
  184. *         write(6,*) 'delr0' , delr0,xmult,seq01, icaz
  185.         endif
  186.        if (ipfx.eq.1) then
  187.          if (seq01.lt.0) then
  188.            icaz = 2
  189.            seq01 = seqtot/2.
  190.          else if (seq01.eq.0.) then
  191.            icaz =1
  192.            seq01 = seqtot/2.
  193.          endif
  194.        endif
  195.         varseq = abs((seq01 - seq0) / seq0)
  196.            if (ib.eq.1.and.igau.eq.1) then
  197. c        write(6,*) 'variation relative', varseq
  198.            endif
  199.         seq0 = seq01
  200.          if (seq0 .lt.0.) then
  201. c          write(6,*) 'erreur point fixe', seqtot, seq0
  202.          moterr(1:16) = conm
  203.          moterr(17:24) = 'CFLUN2-6'
  204.           call erreur(943)
  205.           return
  206.          endif
  207.          if (varseq.lt.1.e-6) goto 100
  208.  
  209.       enddo
  210.  
  211.   100    if (seqtot - seq0 .lt.0.) then
  212. c          write(6,*) 'erreur point fixe', seqtot, seq0
  213.          moterr(1:16) = conm
  214.          moterr(17:24) = 'CFLUN2-7'
  215.           call erreur(943)
  216.           return
  217.          endif
  218.  
  219. c au final
  220.  1000  continue
  221.       do ic = 1,nstrs
  222.         sigf(ic) = dsigt(ic) * seq0 / seqtot
  223.       enddo
  224.  
  225.  
  226.       varf(1) = var0(1) + xc1*(seq0**xn1)*(tempf**xm1)*delt
  227.       varf(2) = var0(2)
  228.  
  229. * position vis a vis des abaques
  230.       if (ips1.gt.0) then
  231.         temcri =0.d0
  232.  
  233.         mevoll = ips1
  234.         segact mevoll
  235.         kevoll = ievoll(1)
  236.         segact kevoll
  237.         mlree1 = iprogx
  238.         mlree2 = iprogy
  239.         segact mlree1,mlree2
  240.         nds = mlree2.prog(/1)
  241. * suppose valeurs de contraintes decroissantes et temps croissants
  242.         do jds=1,nds-1
  243.           if (mlree2.prog(jds).le.mlree2.prog(jds+1).or.
  244.      &mlree1.prog(jds).ge.mlree1.prog(jds+1)) then
  245.          moterr(1:16) = conm
  246.          moterr(17:24) = 'CFLUN2-8'
  247.           call erreur(943)
  248.           return
  249.            endif
  250.          if(mlree2.prog(jds).ge.seq0.and.seq0.gt.mlree2.prog(jds+1))then
  251.             tosig = (mlree2.prog(jds) - seq0)/
  252.      & (mlree2.prog(jds) - mlree2.prog(jds+1))
  253. * interpole logarithmiquement
  254.             utemp = tosig * (log(mlree1.prog(jds+1))
  255.      & - log(mlree1.prog(jds))) + log(mlree1.prog(jds))
  256.             temcri = exp(utemp)
  257. *
  258.           goto 1001
  259.          endif
  260.         enddo
  261.  
  262.  1001   if (temcri.gt.0) then
  263.           varf(2) = var0(2) + delt/temcri
  264.           if (varf(2).gt.1) then
  265.           write(6,*) 'detruire prochaine etape', ipmail, conm,ib,igau
  266.           endif
  267.         endif
  268.       endif
  269.  
  270.  1002  continue
  271.        if(ib.eq.1.and.igau.eq.1) then
  272. c        write(6,*) 't0' ,sigf(3),varf(1),varf(2),depst(3),dsigt(3)
  273.        endif
  274.  
  275.  1010  continue
  276.       RETURN
  277.       END
  278.  
  279.  
  280.  
  281.  
  282.  
  283.  
  284.  
  285.  
  286.  
  287.  
  288.  

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