Esope source files

   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'                                                                 
  57 :       CALL ARRET(0)                                                             
  58 :                                                                                 
  59 :  30   CONTINUE                                                                  
  60 : C                                                                               
  60 :       CALL CALUHG(U,H,NG)
  61 :       A=0.D0                                                                    
  62 :       B=1.D0                                                                    
  62 :       CALL CALG1(A,B,NG,H,U,Z,PG)
  63 :       IF(NPG.NE.6) RETURN                                                       
  64 :       PG(3)=PG(1)
  65 :       PG(4)=PG(2)
  66 :       PG(5)=PG(1)
  67 :       PG(6)=PG(2)
  68 :       Z(3)=Z(1)
  69 :       Z(4)=Z(2)
  70 :       Z(5)=Z(1)
  71 :       Z(6)=Z(2)
  72 :       DO 21 L=1,NPG                                                             
  73 :       PG(L)=PG(L)/3.D0                                                          
  74 :  21   CONTINUE                                                                  
  75 : C     SPG=0
  76 : C     DO 22 L=1,NPG
  77 : C     SPG=SPG+PG(L)
  78 : C22   CONTINUE
  79 : C     WRITE(6,1002)SPG
  80 : C     WRITE(6,1002)H
  81 : C     WRITE(6,1002)U
  82 : C     WRITE(6,1002)Z
  83 : C1002 FORMAT(10(1X,1PD11.4))
  84 :       RETURN
  85 :       END                                                                       
  86 :  
  87 :  
  88 :  
  89 :