Esope source files

   1 : C TQUA4A    SOURCE    CHAT      05/01/13    03:44:03     5004           
   2 :       SUBROUTINE TQUA4A(POINTS,QSIGAU,ETAGAU,POIGAU,SHPTOT)                     
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8(A-H,O-Z)                                                  
   5 : ************************************************************************        
   6 : *                                                                               
   7 : *                             T Q U A 4 A                                       
   8 : *                             -----------                                       
   9 : *                                                                               
  10 : * FONCTION: ON ACQUIERT:                                                        
  11 : * ---------    - LES COORDONNEES INTRINSEQUES                                   
  12 : *              - LES FONCTIONS DE FORME ET LEURS DERIVEES                       
  13 : *           POUR L'ELEMENT DE THERMIQUE                                         
  14 : *                                                                               
  15 : * MODULES UTILISES:                                                             
  16 : * -----------------                                                             
  17 : *                                                                               
  18 : -INC CCOPTIO                                                                    
  19 : *                                                                               
  20 : * PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)          
  21 : * -----------                                                                   
  22 : *                                                                               
  23 : *     POINTS  (E)  CHAINE DE CARACTERES:                                        
  24 : *                  'NOEUDS' SI ON VEUT LES VALEURS AUX NOEUDS                   
  25 : *                  'GAUSS' POUR LES VALEURS AUX POINTS DE GAUSS.                
  26 : *     QSIGAU  (S) |                                                             
  27 : *     ETAGAU  (S) | COORDONNEES INTRINSEQUES.                                   
  28 : *     POIGAU  (S)  POIDS D'INTEGRATION,SI ON A 'GAUSS'.                         
  29 : *     SHPTOT  (S)  FONCTIONS DE FORME ET LEURS DERIVEES.                        
  30 : *                                                                               
  31 :       REAL*8 QSIGAU(4),ETAGAU(4),POIGAU(4)                                      
  32 :       REAL*8 SHPTOT(6,4,4)                                                      
  33 :       CHARACTER*(*) POINTS                                                      
  34 : *                                                                               
  35 : * CONSTANTES:                                                                   
  36 : * -----------                                                                   
  37 : *                                                                               
  38 : *                                                                               
  39 :       PARAMETER ( X=0.577350269189626D0 )                                       
  40 :       PARAMETER ( O1=1.D0 )                                                     
  41 :       PARAMETER ( O25=0.25D0 )                                                  
  42 : *                                                                               
  43 : *                                                                               
  44 : * AUTEUR, DATE DE CREATION:                                                     
  45 : * -------------------------                                                     
  46 : *                                                                               
  47 : *   J-P.SAUSSAIS OCT.77,REPRIS PAR DENIS ROBERT,LE 23 OCTOBRE 1987.             
  48 : *                                                                               
  49 : * LANGAGE:                                                                      
  50 : * --------                                                                      
  51 : *                                                                               
  52 : *             FORTRAN77                                                         
  53 : *                                                                               
  54 : ************************************************************************        
  55 : *                                                                               
  56 :       IF (POINTS(1:5).EQ.'NOEUD') GOTO 66                                       
  57 :       IF (POINTS(1:5).NE.'GAUSS') GOTO 100                                      
  58 : *                                                                               
  59 : *     COORDONNEES DES 4 POINTS DE GAUSS                                         
  60 : *                                                                               
  61 :       NBPGAU=4                                                                  
  62 :       NBNO=4                                                                    
  63 :       QSIGAU(3)=X                                                               
  64 :       QSIGAU(2)=X                                                               
  65 :       ETAGAU(3)=X                                                               
  66 :       ETAGAU(4)=X                                                               
  67 :       QSIGAU(4)=-X                                                              
  68 :       QSIGAU(1)=-X                                                              
  69 :       ETAGAU(2)=-X                                                              
  70 :       ETAGAU(1)=-X                                                              
  71 :       POIGAU(1)=O1                                                              
  72 :       POIGAU(2)=O1                                                              
  73 :       POIGAU(3)=O1                                                              
  74 :       POIGAU(4)=O1                                                              
  75 :       GOTO 2                                                                    
  76 : *                                                                               
  77 : *     COORDONNEES DES NOEUDS                                                    
  78 : *                                                                               
  79 :    66 CONTINUE                                                                  
  80 :       NBNO=4                                                                    
  81 :       NBPGAU=NBNO                                                               
  82 :       QSIGAU(3)=O1                                                              
  83 :       ETAGAU(3)=O1                                                              
  84 :       QSIGAU(4)=-O1                                                             
  85 :       ETAGAU(4)=O1                                                              
  86 :       QSIGAU(1)=-O1                                                             
  87 :       ETAGAU(1)=-O1                                                             
  88 :       QSIGAU(2)=O1                                                              
  89 :       ETAGAU(2)=-O1                                                             
  90 : *                                                                               
  91 : *     FONCTIONS DE FORME ET LEURS DERIVEES                                      
  92 : *                                                                               
  93 :     2 DO 1 I=1,NBPGAU                                                           
  94 :       XI=QSIGAU(I)                                                              
  95 :       YI=ETAGAU(I)                                                              
  96 :       SHPTOT(1,3,I)=O25*(O1+XI)*(O1+YI)                                         
  97 :       SHPTOT(1,4,I)=O25*(O1-XI)*(O1+YI)                                         
  98 :       SHPTOT(1,1,I)=O25*(O1-XI)*(O1-YI)                                         
  99 :       SHPTOT(1,2,I)=O25*(O1+XI)*(O1-YI)                                         
 100 : C                                                                               
 101 :       SHPTOT(2,3,I)=O25*(O1+YI)                                                 
 102 :       SHPTOT(2,4,I)=-O25*(O1+YI)                                                
 103 :       SHPTOT(2,1,I)=-O25*(O1-YI)                                                
 104 :       SHPTOT(2,2,I)=O25*(O1-YI)                                                 
 105 : C                                                                               
 106 :       SHPTOT(3,3,I)=O25*(O1+XI)                                                 
 107 :       SHPTOT(3,4,I)=O25*(O1-XI)                                                 
 108 :       SHPTOT(3,1,I)=-O25*(O1-XI)                                                
 109 :       SHPTOT(3,2,I)=-O25*(O1+XI)                                                
 110 :  1    CONTINUE                                                                  
 111 :       RETURN                                                                    
 112 :  100  CONTINUE                                                                  
 112 :       CALL ERREUR(19)                                                           
 113 : *                                                                               
 114 :       END                                                                       
 115 :