Télécharger la plaquette Cast3M


fr en

Télécharger calhpr.eso

Retour à la liste

Numérotation des lignes : 

calhpr

  1. C CALHPR    SOURCE    CHAT      05/01/12    21:46:12     5004
  2.       SUBROUTINE CALHPR(X,Y,Z,PG,NPG)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. C************************************************************************
  6. C     CE SOUS PROGRAMME CALCULE LES POINTS D'INTEGRATION POUR UN
  7. C     PRISME
  8. C***********************************************************************
  9. C VERSION    : ????
  10. C HISTORIQUE : 20/12/99: gounand
  11. C    Modification du placement des points de Gauss (cas NPG=6)
  12. C    sur le triangle de base du prisme (avant, ils étaient sur les
  13. C    faces)
  14. C
  15. C HISTORIQUE :
  16. C HISTORIQUE :
  17. C***********************************************************************
  18. C
  19. C************************************************************************
  20.       DIMENSION PG(NPG)
  21.       REAL*8 X(NPG),Y(NPG),Z(NPG),U(5),H(5)
  22. C     DATA R2/1.414213562/
  23. C***
  24.       R2=SQRT(2.D0)
  25.  
  26.  
  27.  
  28.       IF(NPG.EQ.1.OR.NPG.EQ.2)THEN
  29. C
  30.       NG=NPG
  31.       X(1)=1.D0/3.D0*R2
  32.       Y(1)=1.D0/3.D0*R2
  33.       X(2)=1.D0/3.D0*R2
  34.       Y(2)=1.D0/3.D0*R2
  35.       GO TO 30
  36.       ENDIF
  37. C
  38.       IF(NPG.EQ.6)THEN
  39.       NG=2
  40.       X(1)=R2/6.D0
  41.       Y(1)=R2/6.D0
  42.       X(2)=2.D0*R2/3.D0
  43.       Y(2)=R2/6.D0
  44.       X(3)=R2/6.D0
  45.       Y(3)=2.D0*R2/3.D0
  46.       X(4)=X(1)
  47.       Y(4)=Y(1)
  48.       X(5)=X(2)
  49.       Y(5)=Y(2)
  50.       X(6)=X(3)
  51.       Y(6)=Y(3)
  52.       GO TO 30
  53.       ENDIF
  54.  
  55.       WRITE(6,*)' SUB CALHPR : NPG=',NPG
  56.       WRITE(6,*)' NOMBRE DE POINTS D''INTEGRATION INCORECTE POUR UN ',
  57.      & 'PRISME'
  58.       CALL ARRET(0)
  59.  
  60.  30   CONTINUE
  61. C
  62.       CALL CALUHG(U,H,NG)
  63.       A=0.D0
  64.       B=1.D0
  65.       CALL CALG1(A,B,NG,H,U,Z,PG)
  66.       IF(NPG.NE.6) RETURN
  67.       PG(3)=PG(1)
  68.       PG(4)=PG(2)
  69.       PG(5)=PG(1)
  70.       PG(6)=PG(2)
  71.       Z(3)=Z(1)
  72.       Z(4)=Z(2)
  73.       Z(5)=Z(1)
  74.       Z(6)=Z(2)
  75.       DO 21 L=1,NPG
  76.       PG(L)=PG(L)/3.D0
  77.  21   CONTINUE
  78. C     SPG=0
  79. C     DO 22 L=1,NPG
  80. C     SPG=SPG+PG(L)
  81. C22   CONTINUE
  82. C     WRITE(6,1002)SPG
  83. C     WRITE(6,1002)H
  84. C     WRITE(6,1002)U
  85. C     WRITE(6,1002)Z
  86. C1002 FORMAT(10(1X,1PD11.4))
  87.       RETURN
  88.       END
  89.  
  90.  
  91.  
  92.  
  93.  

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