Download heflmi.eso

Back to the list

   1 : C HEFLMI    SOURCE    CHAT      05/01/13    00:23:41     5004           
   2 : 
   3 :       SUBROUTINE HESSFLMIEHE (SIG,VAR,AMAT,NDIMA)
   4 :       IMPLICIT INTEGER(I-N)
   5 :       integer ndima,m,i,j
   6 :       real*8  sig(3),var,amat(ndima,ndima)
   7 :       real*8  desv(3),aux1,aux2,alpha1,alpha2,alpha3,amataux(3,3)
   8 :       real*8  valor
   9 :       real*8            sigy0,kiso,siginf,velo,cpar,mpar
  10 :       common /miehdata/ sigy0,kiso,siginf,velo,cpar,mpar
  10 :       call zzero(amat,ndima*ndima)
  11 :       m=nint(mpar)
  11 :       call yieldmieheb(sig,valor)
  12 :       aux1=valor**(1-2*m)/2.D0*sqrt(2.D0/3.D0)
  13 :       aux2=aux1*cpar*3.D0**(2*m)/(2.D0**(2*m-1)+1.D0)*float(2*m-1)
  14 :       aux1=aux1*(1.D0-cpar)*float(2*m-1)
  14 :       call Desviador(sig,desv,3)
  15 :       if (m.gt.1) then 
  16 :        alpha1=(desv(1)-desv(2))**(2*m-2)
  17 :        alpha2=(desv(2)-desv(3))**(2*m-2)
  18 :        alpha3=(desv(3)-desv(1))**(2*m-2)
  19 :       else
  20 :        alpha1=1.D0
  21 :        alpha2=1.D0
  22 :        alpha3=1.D0
  23 :       endif
  24 :       amat(1,1)=alpha1+alpha3
  25 :       amat(2,2)=alpha1+alpha2
  26 :       amat(3,3)=alpha2+alpha3
  27 :       amat(1,2)=-alpha1*aux1
  28 :       amat(1,3)=-alpha3*aux1
  29 :       amat(2,3)=-alpha2*aux1
  30 :       amat(2,1)=amat(1,2)
  31 :       amat(3,1)=amat(1,3)
  32 :       amat(3,2)=amat(2,3)
  33 :       if (m.gt.1) then 
  34 :        do i=1,3
  35 :         amat(i,i)=aux1*amat(i,i)+aux2*desv(i)**(2*m-2)
  36 :        enddo
  37 :       else
  38 :        do i=1,3
  39 :         amat(i,i)=aux1*amat(i,i)+aux2
  40 :        enddo
  41 :       endif
  42 : c desviador de columnas
  43 :       do i=1,3
  43 :        call Desviador(amat(1,i),amataux(1,i),3)
  44 :       enddo
  45 : c trasponer amat
  46 :       aux1=amataux(1,2)
  47 :       amataux(1,2)=amataux(2,1)
  48 :       amataux(2,1)=aux1
  49 :       aux1=amataux(1,3)
  50 :       amataux(1,3)=amataux(3,1)
  51 :       amataux(3,1)=aux1
  52 :       aux1=amataux(2,3)
  53 :       amataux(2,3)=amataux(3,2)
  54 :       amataux(3,2)=aux1
  55 : c desviador de columnas
  56 :       do i=1,3
  56 :        call Desviador(amataux(1,i),amat(1,i),3)
  57 :       enddo
  58 : c no se traspone otra vez pq es simetrica
  58 :       call vflsigmiehe(sig,amataux(1,1))
  59 :       aux2=float(1-2*m)/valor*sqrt(3.D0/2.D0)
  60 :       do i=1,3
  61 :        do j=1,3
  62 :         amat(i,j)=amat(i,j)+amataux(i,1)*amataux(j,1)*aux2
  63 :        enddo
  64 :       enddo
  65 :       return
  66 :       end
  67 :  
  68 :  
  69 :  

© Cast3M 2003 - All rights reserved.
Disclaimer