Esope source files

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