Esope source files

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