Sources Esope | Cast3M

mtc1j2
C MTC1J2    SOURCE    CHAT      05/01/13    01:53:34     5004
CCC
C **********************************************************************
CCC
      SUBROUTINE MTC1J2 (K,NDIMK,X,NDIMX,NDIMV,LAM,NDIMS,
     .                   nescri,ues,kerre)
      IMPLICIT INTEGER(I-N)
      integer ndims,nescri,ndimx,ues,ifi,jc,i,j,kerre,ndimk,ndimv
      real*8  x(*),lam,deltax,K(ndimk,ndimk),g
      real*8  Amat(49),Gmat(49),vecn(7),vecm(7),Avecm(7),vecntA(7)
      kerre=0
        do i=1,7
         Avecm(i)=0.D0
         vecntA(i)=0.D0
         vecn(i)=0.D0
         vecm(i)=0.D0
        enddo
        do i=1,49
         amat(i)=0.D0
         gmat(i)=0.D0
        enddo
      call MatGenHookinv(Gmat,ndimx,ndims)
      call vflsigJ2(x,ndims,x(ndimx),ndimv,vecm)
        call vflvarJ2(x,ndims,x(ndimx),ndimv,vecm(ndimx))
      call vyisigJ2(x,ndims,x(ndimx),ndimv,vecn)
        call vyivarJ2(x,ndims,x(ndimx),ndimv,vecn(ndimx))
      call HessFlsigJ2(x,ndims,x(ndimx),ndimv,Amat,ndimx)
      do i=1,ndimx*ndimx
         Amat(i)=Gmat(i)+lam*Amat(i)
      enddo
      call DescLU(Amat,ndimx)
      call LUinv(Amat,Gmat,ndimx)
      g=0.D0
      do i=1,ndimx
         do j=1,ndimx
             g=g+vecn(i)*Gmat(i+ndimx*(j-1))*vecm(j)
         enddo
      enddo
      do i=1,ndims
         do j=1,ndimx
           Avecm(i)=Avecm(i)+Gmat(i+ndimx*(j-1))*vecm(j)
           vecntA(i)=vecntA(i)+vecn(j)*Gmat(j+ndimx*(i-1))
         enddo
      enddo
      do ifi=1,ndims
         do jc=1,ndims
            K(ifi,jc)=Gmat((jc-1)*ndimx+ifi)-Avecm(ifi)*vecntA(jc)/g
         enddo
      enddo
      return
      end