Télécharger la plaquette Cast3M


fr en

Télécharger jac0rh.eso

Retour à la liste

Numérotation des lignes : 

jac0rh

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

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