Esope source files

   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'                                                                 
  69 :       CALL ARRET(0)                                                             
  70 :                                                                                 
  71 :  30   CONTINUE                                                                  
  72 : C                                                                               
  72 :       CALL CALUHG(U,H,NG)
  72 :       CALL CALG1(Z1,Z2,NG,H,U,Z,PG)
  73 :       IF(NPG.NE.6) RETURN                                                       
  74 :       PG(3)=PG(1)
  75 :       PG(4)=PG(2)
  76 :       PG(5)=PG(1)
  77 :       PG(6)=PG(2)
  78 :       Z(3)=Z(1)
  79 :       Z(4)=Z(2)
  80 :       Z(5)=Z(1)
  81 :       Z(6)=Z(2)
  82 :       DO 21 L=1,NPG                                                             
  83 :       PG(L)=PG(L)/12.D0
  84 :  21   CONTINUE                                                                  
  85 : C     SPG=0
  86 : C     DO 22 L=1,NPG
  87 : C     SPG=SPG+PG(L)
  88 : C22   CONTINUE
  89 : C     WRITE(6,1002)SPG
  90 : C     WRITE(6,1002)H
  91 : C     WRITE(6,1002)U
  92 : C     WRITE(6,1002)Z
  93 : C1002 FORMAT(10(1X,1PD11.4))
  94 :       RETURN
  95 :       END                                                                       
  96 :  
  97 :  
  98 :  
  99 :