Télécharger la plaquette Cast3M


fr en

Télécharger hprime.eso

Retour à la liste

Numérotation des lignes : 

hprime

  1. C HPRIME    SOURCE    PV        20/09/15    21:15:02     10713          
  2.       SUBROUTINE HPRIME(XE,NBNN,IDIM,SHPTOT,IGAU,SHPWRK,DJAC)
  3. C=======================================================================
  4. C
  5. C   ENTREES
  6. C     XE(3,NBNN)= COORDONNEES DES NOEUDS
  7. C     NBNN      = NOMBRE DES NOEUDS
  8. C     IDIM      = DIMENSION DU PROBLEME
  9. C     SHPTOT(6,NBNO,IGAU)= FONCTIONS DE FORME REDUITES (VIENT DE MINTE
  10. C     IGAU      =NUMERO DU POINT DE GAUUS
  11. C  SORTIES
  12. C     SHPWRK(6,NBNO)= H  H,X   H,Y   H,Z
  13. C     DJAC      =JACOBIEN
  14. C
  15. C=======================================================================
  16.       IMPLICIT INTEGER(I-N)
  17.       IMPLICIT REAL*8(A-H,O-Z)
  18.       DIMENSION XE(3,*),SHPTOT(6,NBNN,*),SHPWRK(6,*)
  19.       IDIM1=IDIM+1
  20.       if(idim1.ge.6) then
  21.       DO  IA=1,NBNN
  22.       SHPWRK(6,IA)=SHPTOT(6,IA,IGAU)
  23.       SHPWRK(5,IA)=SHPTOT(5,IA,IGAU)
  24.       SHPWRK(4,IA)=SHPTOT(4,IA,IGAU)
  25.       SHPWRK(3,IA)=SHPTOT(3,IA,IGAU)
  26.       SHPWRK(2,IA)=SHPTOT(2,IA,IGAU)
  27.       SHPWRK(1,IA)=SHPTOT(1,IA,IGAU)
  28.       enddo
  29.       endif
  30.       if(idim1.eq.5) then
  31.       DO  IA=1,NBNN
  32.       SHPWRK(5,IA)=SHPTOT(5,IA,IGAU)
  33.       SHPWRK(4,IA)=SHPTOT(4,IA,IGAU)
  34.       SHPWRK(3,IA)=SHPTOT(3,IA,IGAU)
  35.       SHPWRK(2,IA)=SHPTOT(2,IA,IGAU)
  36.       SHPWRK(1,IA)=SHPTOT(1,IA,IGAU)
  37.       enddo
  38.       endif
  39.       if(idim1.eq.4) then
  40.       DO  IA=1,NBNN
  41.       SHPWRK(4,IA)=SHPTOT(4,IA,IGAU)
  42.       SHPWRK(3,IA)=SHPTOT(3,IA,IGAU)
  43.       SHPWRK(2,IA)=SHPTOT(2,IA,IGAU)
  44.       SHPWRK(1,IA)=SHPTOT(1,IA,IGAU)
  45.       enddo
  46.       endif
  47.       if(idim1.eq.3) then
  48.       DO  IA=1,NBNN
  49.       SHPWRK(3,IA)=SHPTOT(3,IA,IGAU)
  50.       SHPWRK(2,IA)=SHPTOT(2,IA,IGAU)
  51.       SHPWRK(1,IA)=SHPTOT(1,IA,IGAU)
  52.       enddo
  53.       endif
  54.       if(idim1.eq.2) then
  55.       DO  IA=1,NBNN
  56.       SHPWRK(2,IA)=SHPTOT(2,IA,IGAU)
  57.       SHPWRK(1,IA)=SHPTOT(1,IA,IGAU)
  58.       enddo
  59.       endif
  60.       if(idim1.eq.1) then
  61.       DO  IA=1,NBNN
  62.       SHPWRK(1,IA)=SHPTOT(1,IA,IGAU)
  63.       enddo
  64.       endif
  65.       CALL JACOBI(XE,SHPWRK,IDIM,NBNN,DJAC)
  66.       RETURN
  67.       END
  68.  
  69.  
  70.  

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