Esope source files

   1 : C PB302     SOURCE    MAGN      10/05/18    21:16:33     6675           
   2 :       SUBROUTINE PB302(XREF,X,Y,PG,FN,GR,FM,GM,ND,NP,MP,NPG,NOM2,ITYPI)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
   5 : C************************************************************************       
   6 : C                                                                               
   7 : C     CALCULE LES FONCTIONS DE FORME D'UN : TRI3
   8 : C                                                                               
   9 : C     ^ eta
  10 : C     |
  11 : C   a |n3
  12 : C     |\
  13 : C     | \     a=sqrt(2)
  14 : C     |  \
  15 : C     |___\ _____>ksi
  16 : C     0   a
  17 : C     n1  n2
  18 : C                                                                               
  19 : C                                                                               
  20 : C************************************************************************       
  21 :                                                                                 
  22 :       REAL*8 XREF(ND,NP),X(NPG),Y(NPG)
  23 :       DIMENSION FN(NP,NPG),GR(ND,NP,NPG),PG(NPG)                                
  24 :       DIMENSION FM(MP,NPG),GM(ND,MP,NPG)
  25 :       REAL*8 A,B,C,D,U(5),H(5)
  26 :       CHARACTER*4 NOM2
  27 : C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>        
  28 : 
  29 :       NP2=NP*ND                                                                 
  30 : 
  31 :       R2=SQRT(2.D0)
  32 : 
  33 :       XREF(1,1)=0.D0
  34 :       XREF(2,1)=0.D0
  35 :       XREF(1,2)=R2
  36 :       XREF(2,2)=0.D0
  37 :       XREF(1,3)=0.D0
  38 :       XREF(2,3)=R2
  39 : 
  40 :       IF(ITYPI.EQ.2)THEN
  41 :       X(1)=0.D0
  42 :       Y(1)=0.D0
  43 :       X(2)=R2
  44 :       Y(2)=0.D0
  45 :       X(3)=0.D0
  46 :       Y(3)=R2
  47 :       DO 2 L=1,3
  48 :       PG(L)=1.D0/3.D0
  49 :  2    CONTINUE
  50 :       ELSE
  50 :       CALL CALUHH(X,Y,PG,NPG)                                                   
  51 :       ENDIF
  52 :       DO 1 L=1,NPG                                                              
  53 : C                                                                               
  54 :       FN(1,L)=-R2/2.D0*(X(L)+Y(L)-R2)
  55 :       FN(2,L)=R2/2.D0*X(L)
  56 :       FN(3,L)=R2/2.D0*Y(L)
  57 : C                                                                               
  58 :       GR(1,1,L)=-R2/2.D0
  59 :       GR(2,1,L)=-R2/2.D0
  60 :       GR(1,2,L)=R2/2.D0
  61 :       GR(2,2,L)=0.D0                                                            
  62 :       GR(1,3,L)=0.D0                                                            
  63 :       GR(2,3,L)=R2/2.D0
  64 : C                                                                               
  65 : 
  66 :       IF(NOM2.EQ.'P1P1')THEN
  67 :       FM(1,L)=FN(1,L)
  68 :       FM(2,L)=FN(2,L)
  69 :       FM(3,L)=FN(3,L)
  70 :       GM(1,1,L)=-R2/2.D0
  71 :       GM(2,1,L)=-R2/2.D0
  72 :       GM(1,2,L)=R2/2.D0
  73 :       GM(2,2,L)=0.D0
  74 :       GM(1,3,L)=0.D0
  75 :       GM(2,3,L)=R2/2.D0
  76 :       ELSE
  77 :       FM(1,L)=1.D0
  78 :       GM(1,1,L)=0.D0
  79 :       GM(2,1,L)=0.D0
  80 :       ENDIF
  81 : 
  82 :  1    CONTINUE                                                                  
  83 : 
  84 : C     WRITE(6,101)
  85 : C     WRITE(6,1002)FM
  86 : C     WRITE(6,1002)GM
  87 : C     WRITE(6,1002)FN
  88 : C     WRITE(6,1002)GR
  89 : C     WRITE(6,101)
  90 :       RETURN                                                                    
  91 :  1002 FORMAT(10(1X,1PD11.4))                                                    
  92 :  1001 FORMAT(20(1X,I5))                                                         
  93 :  101  FORMAT(1X,'... SUBPB302 ... FM,GM,FN,GR ',9(10H..........)/)              
  94 : C                                                                               
  95 :       END                                                                       
  96 :  
  97 :  
  98 :  
  99 :  
 100 :  
 101 :