Télécharger la plaquette Cast3M


fr en

Télécharger weipa1.eso

Retour à la liste

Numérotation des lignes : 

weipa1

  1. C WEIPA1    SOURCE    GF238795  18/02/01    21:16:33     9724           
  2. c***********************************************************************
  3. c Metodo della  Massima  Verosimiglianza . Soluzione iterativa  della  *
  4. c equazione seguente con il metodo delle bisezioni :                   *
  5. c                                                                      *
  6. c m=N/(N*SUM(sig(i)**m*log(sig(i)))/SUM(sig(i)**m)-SUM(log(sig(i)))) *
  7. c                                                                      *
  8. c***********************************************************************
  9. c
  10.       SUBROUTINE WEIPA1(n,sig,volut,rappca,rml,sigzer)
  11. c
  12.       IMPLICIT INTEGER(I-N)
  13.       IMPLICIT REAL*8(A-H,O-Z)
  14.       dimension sig(n)
  15. c
  16. c precisione di calcolo della soluzione
  17.       eps=1.0e-6
  18. c incremento di 'm' per la ricerca dell'intervallo contenente la soluz.
  19.       rincr=0.1e+1
  20.       rn=float(n)
  21. c valore di partenza di 'm'
  22.       rml=1.0e-6
  23. c valore di partenza della differenza tra i membri dell'equazione
  24.       diffa=0.
  25.       do 11 j=1,1000
  26.         call emme(n,rml,sig,sum1,diff)
  27.         diffb=diff
  28.         if(diffa*diffb.lt.0.)then
  29.           a1=rml1
  30.           b2=rml
  31.           c2=log((b2-a1)/eps)/log(2.)+1.
  32.           l=INT(c2)
  33.           do 3 k=1,l
  34.             rml=(b2+a1)/2.
  35.             call emme(n,rml,sig,sum1,diff)
  36.             if(diff*diffa.lt.0.)then
  37.               b2=rml
  38.             else
  39.               a1=rml
  40.               diffa=diff
  41.             endif
  42.    3      continue
  43.           go to 999
  44.         else
  45.           rml1=rml
  46.           diffa=diffb
  47.           rml=rml+rincr
  48.         endif
  49.   11  continue
  50. C
  51.  999  continue
  52. C
  53.       b1=rn/sum1
  54. C
  55. c calcolo del volume effettivo
  56.       rkv=(rappca*rml+1.)/(2.*(rml+1.)**2)
  57.       volef=volut*rkv
  58. C
  59. C sigma zero
  60.       sigzer = (volef / b1 ) ** (1./rml)
  61. C
  62. C funzioni gamma
  63.       uno  = 1.+ 1./rml
  64.       rdue = 1.+ 2./rml
  65.       gam1 = gamma(uno)
  66.       gam2 = gamma(rdue)
  67. C
  68. C valore medio
  69.       sigmed=b1**(-1./rml)*gam1
  70. C
  71. C varianza e deviazione standard
  72.       var   = b1**(-2./rml)*(gam2-gam1*gam1)
  73.       devst = sqrt(var)
  74. C
  75. *      write(6,13)volut
  76. *  13  format(/,1x,'VOLUME UTILE                 :',e15.8)
  77. *      write(6,991)volef
  78. *  991 format(1x,'VOLUME EFFETTIVO DEL PROVINO :',e15.8)
  79.       write(6,400)
  80.  400  format(1x,'Mean stress    ',1x,'  Variance     ')
  81.       write(6,500)sigmed,var
  82.  500  format(2(1x,e15.8),/)
  83. c
  84.       return
  85.       end
  86.  
  87.  
  88.  
  89.  
  90.  
  91.  

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