Télécharger la plaquette Cast3M


fr en

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