Esope source files

   1 : C MTC21     SOURCE    CHAT      05/01/13    01:53:37     5004           
   2 : CCC
   3 : C **********************************************************************
   4 : CCC
   5 :       SUBROUTINE MTC21 (K,NDIMK,X,NDIMX,LAM,NDIMS,
   6 :      .                nmodel,nescri,ues,nnumer,deltax,kerre)
   7 :       IMPLICIT INTEGER(I-N)
   8 :       integer ndims,nmodel,nescri,nnumer,ndimx,ues
   9 :       integer ifi,jc,i,j,kerre,ndimk
  10 :       real*8    x(ndimx),lam,deltax,K(ndimk,ndimk),g
  11 :       real*8    Amat(64),Gmat(64),vecn(8),vecm(8),Avecm(8),vecntA(8)
  12 :       kerre=0
  13 :       do i=1,8
  14 :           vecntA(i)=0.D0
  15 :           Avecm(i)=0.D0
  16 :           vecn(i)=0.D0
  17 :           vecm(i)=0.D0
  18 :         enddo
  19 :       do i=1,64
  20 :           Amat(i)=0.D0
  21 :           Gmat(i)=0.D0
  22 :         enddo
  22 :       call MatGenHookinv(Gmat,ndimx,ndims)
  22 :       call VecFlMAC(x,ndimx,vecm,nmodel)
  22 :       call VecYiMAC(x,ndimx,vecn,nmodel)
  22 :       call HessMAC(x,ndimx,Amat,ndimx,nnumer,deltax,nmodel)
  23 :       do i=1,ndimx*ndimx
  24 :          Amat(i)=Gmat(i)+lam*Amat(i)
  25 :       enddo
  25 :       call DescLU(Amat,ndimx)
  25 :       call LUinv(Amat,Gmat,ndimx)
  26 :       g=0.D0
  27 :       do i=1,ndimx
  28 :          do j=1,ndimx
  29 :              g=g+vecn(i)*Gmat(i+ndimx*(j-1))*vecm(j)
  30 :          enddo
  31 :       enddo
  32 :       do i=1,ndims
  33 :          do j=1,ndimx
  34 :            Avecm(i)=Avecm(i)+Gmat(i+ndimx*(j-1))*vecm(j)
  35 :            vecntA(i)=vecntA(i)+vecn(j)*Gmat(j+ndimx*(i-1))
  36 :          enddo
  37 :       enddo
  38 :       do ifi=1,ndims
  39 :          do jc=1,ndims
  40 :             K(ifi,jc)=Gmat((jc-1)*ndimx+ifi)-Avecm(ifi)*vecntA(jc)/g
  41 :          enddo
  42 :       enddo
  43 :       return
  44 :       end
  45 :  
  46 :