Download func.eso

Back to the list

   1 : C FUNC      SOURCE    CHAT      05/01/13    00:11:36     5004           
   2 : c*****************************************************************************
   3 : c       sous rouine utilisee dans l'ecoulement plastique de la loi
   4 : c       de GURSON 
   5 : c**********************************************************************
   6 :         subroutine func(f,q,wrkgur)
   7 : c       this subroutine compute the value of the function
   8 : c       which zero is the increment of phi
   9 : c
  10 : c---    variables
  11 :       IMPLICIT INTEGER(I-N)
  12 :         IMPLICIT REAL*8 (A-H,O-Z)
  13 :          
  14 :         segment wrkgur
  15 :          real*8 sigbar, sy0,phi0,rho0,g,b,h
  16 :          real*8 epn,phin,sqrtj2,rho,sig(6)
  17 :          real*8 e(7),dt
  18 :          real*8 conv,tol1,tol2
  19 :         endsegment
  20 : 
  21 : *        common/prop/sigbar,sy0,phi0,rho0,g,b,h
  22 : *        common/state/epn,phin,sqrtj2,rho,sig(6)
  23 : c
  24 : *       common /toler/ conv,tol1,tol2
  25 : c
  26 : c***    evaluate function -- q is dphi
  27 :         phi=phin+q
  28 :         syn=sy0+h*epn
  29 :         p=(1.d0-phi)*b*(1.d0-(1.d0-phi)*rho0/((1.d0-phi0)*rho))
  30 :         syp=abs(1.d0+phi**2-2.d0*phi*cosh(-1.5d0*p/sigbar))
  31 : c
  32 :         if (syp .ge. tol1*tol1 ) then
  33 :         a=1.5d0*phi*(1.d0-phi)*sinh(-1.5d0*p/sigbar)/sqrt(syp)
  34 : c
  35 :             if ( abs(a) .le. (1.d-2 * tol2) ) then
  36 : c       this is not consistent but this speeds up the convergence 
  37 :                 dep=(sqrtj2-syn*(1-phi))/(3*g+h*(1-phi))
  38 :             else
  39 :                 ratio=syn/(2.d0*h)
  40 :                 dep=sqrt(ratio**2+abs(q/a)*sigbar/h)-ratio
  41 :             endif
  42 : c
  43 :         else
  44 :             dep=0.d0
  45 :         endif
  46 : c
  47 :         syn1p=(syn+h*dep)*sqrt(syp)
  48 :         f=syn1p+3.d0*g*dep-sqrtj2
  49 :         f=f/sy0
  50 : c
  51 :         return
  52 :         end
  53 : c*****************************************************************************
  54 : 
  55 : 
  56 : 
  57 : 
  58 :  
  59 :  

© Cast3M 2003 - All rights reserved.
Disclaimer