Télécharger la plaquette Cast3M


fr en

Télécharger khprm.eso

Retour à la liste

Numérotation des lignes : 

khprm

  1. C KHPRM     SOURCE    CHAT      05/01/13    00:56:27     5004
  2.       SUBROUTINE KHPRM(X,Y,Z,PG,NPG,X1,Y1,X2,Y2,Z1,Z2)
  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 MACRO
  8. C
  9. C   |X1  o
  10. C   |Y2  |\
  11. C        | \
  12. C        |  \
  13. C        |   \
  14. C        |    \
  15. C        |     \
  16. C |X1    |      \   |(X1+X2)/2
  17. C |Y1+Y2 x       x  |(Y1+Y2)/2
  18. C |----- |        \
  19. C |  2   |         \
  20. C        |          \
  21. C        |      cas 3 pts d'integrations sur le triangle
  22. C        |            \
  23. C        |             \
  24. C        |              \
  25. C  |X1   o_______x_______o   |X2
  26. C  |Y1                       |Y1
  27. C               |(X1+X2)/2
  28. C               |Y1
  29. C
  30. C
  31. C
  32. C
  33. C
  34. C************************************************************************
  35.       DIMENSION PG(NPG)
  36.       REAL*8 X(NPG),Y(NPG),Z(NPG),U(5),H(5)
  37. C***
  38.  
  39.  
  40.       IF(NPG.EQ.2)THEN
  41. C
  42.       NG=1
  43.       X(1)=1.D0/3.D0*(X2-X1)
  44.       Y(1)=1.D0/3.D0*(Y2-Y1)
  45.       X(2)=X(1)
  46.       Y(2)=Y(1)
  47.       GO TO 30
  48.       ENDIF
  49. C
  50.       IF(NPG.EQ.6)THEN
  51.       NG=2
  52.       X(1)=X1
  53.       Y(1)=(Y1+Y2)/2.D0
  54.       X(3)=(X1+X2)/2.D0
  55.       Y(3)=Y1
  56.       X(5)=(X1+X2)/2.D0
  57.       Y(5)=(Y1+Y2)/2.D0
  58.       X(2)=X(1)
  59.       Y(2)=Y(1)
  60.       X(4)=X(3)
  61.       Y(4)=Y(3)
  62.       X(6)=X(5)
  63.       Y(6)=Y(5)
  64.       GO TO 30
  65.       ENDIF
  66.  
  67.       WRITE(6,*)' SUB CALHPR : NPG=',NPG
  68.       WRITE(6,*)' NOMBRE DE POINTS D''INTEGRATION INCORECTE POUR UN ',
  69.      & 'PRISME'
  70.       CALL ARRET(0)
  71.  
  72.  30   CONTINUE
  73. C
  74.       CALL CALUHG(U,H,NG)
  75.       CALL CALG1(Z1,Z2,NG,H,U,Z,PG)
  76.       IF(NPG.NE.6) RETURN
  77.       PG(3)=PG(1)
  78.       PG(4)=PG(2)
  79.       PG(5)=PG(1)
  80.       PG(6)=PG(2)
  81.       Z(3)=Z(1)
  82.       Z(4)=Z(2)
  83.       Z(5)=Z(1)
  84.       Z(6)=Z(2)
  85.       DO 21 L=1,NPG
  86.       PG(L)=PG(L)/12.D0
  87.  21   CONTINUE
  88. C     SPG=0
  89. C     DO 22 L=1,NPG
  90. C     SPG=SPG+PG(L)
  91. C22   CONTINUE
  92. C     WRITE(6,1002)SPG
  93. C     WRITE(6,1002)H
  94. C     WRITE(6,1002)U
  95. C     WRITE(6,1002)Z
  96. C1002 FORMAT(10(1X,1PD11.4))
  97.       RETURN
  98.       END
  99.  
  100.  
  101.  
  102.  
  103.  

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