Télécharger la plaquette Cast3M


fr en

Télécharger jac21.eso

Retour à la liste

Numérotation des lignes : 

jac21

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

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