Télécharger la plaquette Cast3M


fr en

Télécharger jac1j2.eso

Retour à la liste

Numérotation des lignes : 

jac1j2

  1. C JAC1J2    SOURCE    CHAT      05/01/13    00:47:59     5004
  2. CCC
  3. C **********************************************************************
  4. CCC
  5.       SUBROUTINE JAC1J2 (KMAT,NDIMK,X,NDIMX,LAM,NDIMS,
  6.      .                   nescri,ues,kerre)
  7.       IMPLICIT INTEGER(I-N)
  8.       integer ndims,nescri,ues,ndimv,ndimx,i,j,k,kerre,ndimk
  9.       real*8  x(ndimx),lam,void,Kmat(ndimk,ndimk),g
  10.       real*8  Amat(49),Gmat(49),vecn(7),vecm(7),Avecm(7),vecntA(7),
  11.      .        vecEm(7),Hmat(49)
  12.       kerre=0
  13.         ndimv=1
  14.       void =0.D0
  15.         do i=1,7
  16.          Avecm(i)=0.D0
  17.          vecntA(i)=0.D0
  18.          vecn(i)=0.D0
  19.          vecm(i)=0.D0
  20.          vecEm(i)=0.D0
  21.         enddo
  22.         do i=1,49
  23.          amat(i)=0.D0
  24.          gmat(i)=0.D0
  25.          hmat(i)=0.D0
  26.         enddo
  27. c m
  28.       call vflsigJ2(x,ndims,x(ndimx),ndimv,vecm)
  29.         call vflvarJ2(x,ndims,x(ndimx),ndimv,vecm(ndimx))
  30. c n
  31.       call vyisigJ2(x,ndims,x(ndimx),ndimv,vecn)
  32.         call vyivarJ2(x,ndims,x(ndimx),ndimv,vecn(ndimx))
  33. c H
  34.       call HessFlsigJ2(x,ndims,x(ndimx),ndimv,Hmat,ndimx)
  35.  
  36. c G=E
  37.       call MatGenHook(Gmat,ndimx,ndims)
  38. c Em = E*m
  39.       do i=1,ndimx
  40.        do j=1,ndimx
  41.          vecEm(i)=vecEm(i)+Gmat(ndimx*(j-1)+i)*vecm(j)
  42.        enddo
  43.       enddo
  44. c A = I+l*E*H
  45.       do i=1,ndimx
  46.        do j=1,ndimx
  47.         do k=1,ndimx
  48.           Amat(ndimx*(j-1)+i)=Amat(ndimx*(j-1)+i)+
  49.      .                        Gmat(ndimx*(k-1)+i)*Hmat(ndimx*(j-1)+k)
  50.         enddo
  51.         Amat(ndimx*(j-1)+i)=lam*Amat(ndimx*(j-1)+i)
  52.        enddo
  53.        Amat(ndimx*(i-1)+i)=1.D0+Amat(ndimx*(i-1)+i)
  54.       enddo
  55. c G = A-1
  56.       call DescLU(Amat,ndimx)
  57.       call LUinv(Amat,Gmat,ndimx)
  58. c g = nt*A-1*Em
  59.       g=0.D0
  60.       do i=1,ndimx
  61.        do j=1,ndimx
  62.           g=g+vecn(i)*Gmat(i+ndimx*(j-1))*vecEm(j)
  63.        enddo
  64.       enddo
  65. c G*Em; nt*G
  66.       do i=1,ndimx
  67.        do j=1,ndimx
  68.          Avecm(i)=Avecm(i)+Gmat(i+ndimx*(j-1))*vecEm(j)
  69.          vecntA(i)=vecntA(i)+vecn(j)*Gmat(j+ndimx*(i-1))
  70.        enddo
  71.       enddo
  72. c K = G-(G*m * nt*G)/g
  73.       do i=1,ndimx
  74.        do j=1,ndimx
  75.           Kmat(i,j)=Gmat((j-1)*ndimx+i)-Avecm(i)*vecntA(j)/g
  76.        enddo
  77.       enddo
  78.       return
  79.       end
  80.  
  81.  
  82.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales