Télécharger hbmdpp.eso

Retour à la liste

Numérotation des lignes :

hbmdpp
  1. C HBMDPP SOURCE FANDEUR 22/05/02 21:15:22 11359
  2.  
  3. SUBROUTINE HBMDPP(NT,NDDL,X,PHI,DPsiPsi)
  4.  
  5. C=======================================================================
  6. * Calcule la derivee du terme DPsiPsi = (Psi*Psi')/(Psi'*Psi)
  7. * ou: Psi = (L(o)In)*X = Psix*X
  8. C=======================================================================
  9.  
  10. IMPLICIT INTEGER(I-N)
  11. IMPLICIT REAL*8(A-H,O-Z)
  12.  
  13. REAL*8 X(NT),PHI(NT),PSI(NT),LV(NT),DPsiPsi(NT,NT)
  14. REAL*8 PsiV,PsiPsi,BB
  15. REAL*8 PSIX(NT,NT),PEXSI(NT,NT),PEXV(NT,NT),Ax(NT,NT),MUX(NT,NT)
  16.  
  17. C Fonctions BLAS/LAPACK
  18. REAL*8 DDOT, DNRM2
  19. EXTERNAL DDOT, DNRM2
  20.  
  21. c Nombre d'harmoniques
  22. NHBM = (NT/NDDL - 1)/2
  23.  
  24. c Initialisation
  25. DO I = 1,NT
  26. DO J = 1,NT
  27. DPsiPsi(I,J) = 0.D0
  28. PSIX(I,J) = 0.D0
  29. ENDDO
  30. ENDDO
  31.  
  32. c Calcul des vecteurs PSI,LV
  33. CALL HBMDVEC(NT,NHBM,NDDL,X,1.D0,PSI)
  34. CALL HBMDVEC(NT,NHBM,NDDL,PHI,1.D0,LV)
  35.  
  36. c Produits scalaires
  37. PsiV = DDOT(NT,PSI,1,PHI,1)
  38. PSiPsi = DDOT(NT,PSI,1,PSI,1)
  39.  
  40. c Produits externes
  41. CALL PREXT(NT,PSI,PSI,PEXSI)
  42. CALL PREXT(NT,LV,PSI,PEXV)
  43.  
  44. c Construction de Psix*psiv
  45. DO J=2,2*NHBM,2
  46. DO I=1,NDDL
  47. BB = PsiV*J/2.D0
  48. PSIX(NDDL*(1+(J-2))+I,NDDL*(1+(J-1))+I) = BB
  49. PSIX(NDDL*(1+(J-1))+I,NDDL*(1+(J-2))+I) = -BB
  50. ENDDO
  51. ENDDO
  52.  
  53. * Construction de Ax = I-(2/psipsi)*PEXSI
  54. DO I = 1,NT
  55. DO J = 1,NT
  56. Ax(I,J) = (-2.D0/PsiPsi)*PEXSI(I,J)
  57. IF (I.EQ.J) THEN
  58. AX(I,J) = AX(I,J) + 1.D0
  59. ENDIF
  60. ENDDO
  61. ENDDO
  62.  
  63. c Produit MUX = Ax*Psix*psiv
  64. CALL PRMAT(NT,Ax,PSIX,MUX)
  65.  
  66. c Construction de DPsiPsi
  67. DO I = 1,NT
  68. DO J = 1,NT
  69. DPsiPsi(I,J) = (MUX(I,J)-PEXV(I,J))/PsiPsi
  70. ENDDO
  71. ENDDO
  72.  
  73. c return
  74. END
  75.  
  76.  
  77.  

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