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

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