Esope source files

   1 : C PB1503    SOURCE    MAGN      10/05/31    21:15:12     6679           
   2 :       SUBROUTINE PB1503(XREF,XCOPG,XPOPG,
   3 :      $     FFPGV,DFFPGV,
   4 :      $     FFPGP,DFFPGP,
   5 :      $     X,Y,Z,PG,FN,GR,FM,GM,ND,NP,MP,NPG)
   6 :       IMPLICIT INTEGER(I-N)
   7 :       IMPLICIT REAL*8 (A-H,O-Z)
   8 : C************************************************************************
   9 : C                                                                               
  10 : C     CALCULE LES FONCTIONS DE FORME D'UN : TE15
  11 : C************************************************************************       
  12 : * Entrées
  13 :       INTEGER ND,NP,MP,NPG
  14 : *
  15 :       REAL*8 XREF(ND,NP)
  16 :       REAL*8 XCOPG(ND,NPG)
  17 :       REAL*8 XPOPG(NPG)
  18 :       REAL*8 FFPGV(NP,NPG)
  19 :       REAL*8 DFFPGV(NP,ND,NPG)
  20 :       REAL*8 FFPGP(MP,NPG)
  21 :       REAL*8 DFFPGP(MP,ND,NPG)
  22 : * Sorties
  23 :       REAL*8 X(NPG),Y(NPG),Z(NPG)
  24 :       REAL*8 PG(NPG)
  25 :       REAL*8 FN(NP,NPG),GR(ND,NP,NPG)
  26 :       REAL*8 FM(MP,NPG),GM(ND,MP,NPG)
  27 : * Travail
  28 :       INTEGER IPG,IP,ID
  29 :       REAL*8 UNSVOL,USVUSD
  30 : C***                                                                            
  31 : * magn veut que les volumes de ses éléments fasse 1
  32 :       UNSVOL=6.D0
  33 :       USVUSD=UNSVOL**(1.D0/DBLE(ND))
  34 : * Coordonnées des noeuds de l'élément de référence
  35 :       R2=SQRT(2.D0)
  36 :       XREF(1,1)=0.D0
  37 :       XREF(2,1)=0.D0
  38 :       XREF(3,1)=0.D0
  39 : 
  40 :       XREF(1,2)=R2/2.D0
  41 :       XREF(2,2)=0.D0
  42 :       XREF(3,2)=0.D0
  43 : 
  44 :       XREF(1,3)=R2
  45 :       XREF(2,3)=0.D0
  46 :       XREF(3,3)=0.D0
  47 : 
  48 :       XREF(1,4)=R2/2.D0
  49 :       XREF(2,4)=R2/2.D0
  50 :       XREF(3,4)=0.D0
  51 : 
  52 :       XREF(1,5)=0.D0
  53 :       XREF(2,5)=R2
  54 :       XREF(3,5)=0.D0
  55 : 
  56 :       XREF(1,6)=0.D0
  57 :       XREF(2,6)=R2/2.D0
  58 :       XREF(3,6)=0.D0
  59 : 
  60 :       XREF(1,7)=0.D0
  61 :       XREF(2,7)=0.D0
  62 :       XREF(3,7)=R2/2.D0
  63 : 
  64 :       XREF(1,8)=R2/2.D0
  65 :       XREF(2,8)=0.D0
  66 :       XREF(3,8)=R2/2.D0
  67 : 
  68 :       XREF(1,9)=0.D0
  69 :       XREF(2,9)=R2/2.D0
  70 :       XREF(3,9)=R2/2.D0
  71 : 
  72 :       XREF(1,10)=0.D0
  73 :       XREF(2,10)=0.D0
  74 :       XREF(3,10)=R2
  75 : 
  76 :       XREF(1,11)=R2/3.D0
  77 :       XREF(2,11)=R2/3.D0
  78 :       XREF(3,11)=0.D0
  79 : 
  80 :       XREF(1,12)=R2/3.D0
  81 :       XREF(2,12)=0.D0
  82 :       XREF(3,12)=R2/3.D0
  83 : 
  84 :       XREF(1,13)=R2/3.D0
  85 :       XREF(2,13)=R2/3.D0
  86 :       XREF(3,13)=R2/3.D0
  87 : 
  88 :       XREF(1,14)=0.D0
  89 :       XREF(2,14)=R2/3.D0
  90 :       XREF(3,14)=R2/3.D0
  91 : 
  92 :       XREF(1,15)=R2/4.D0
  93 :       XREF(2,15)=R2/4.D0
  94 :       XREF(3,15)=R2/4.D0
  95 : 
  96 : * Recopie des points de Gauss      
  97 :       DO 1 IPG=1,NPG
  98 :          X(IPG)=XCOPG(1,IPG)*USVUSD
  99 :          Y(IPG)=XCOPG(2,IPG)*USVUSD
 100 :          Z(IPG)=XCOPG(3,IPG)*USVUSD
 101 :          PG(IPG)=XPOPG(IPG)*UNSVOL
 102 :  1    CONTINUE
 103 : * Recopie des fns. de forme vitesse
 104 :       DO 3 IPG=1,NPG
 105 :          DO 32 IP=1,NP
 106 :             FN(IP,IPG)=FFPGV(IP,IPG)
 107 :             DO 322 ID=1,ND
 108 :                GR(ID,IP,IPG)=DFFPGV(IP,ID,IPG)
 109 :  322        CONTINUE
 110 :  32      CONTINUE
 111 :  3    CONTINUE
 112 : * Recopie des fns. de forme pression
 113 :       DO 5 IPG=1,NPG
 114 :          DO 52 IP=1,MP
 115 :             FM(IP,IPG)=FFPGP(IP,IPG)
 116 :             DO 522 ID=1,ND
 117 :                GM(ID,IP,IPG)=DFFPGP(IP,ID,IPG)
 118 :  522        CONTINUE
 119 :  52      CONTINUE
 120 :  5    CONTINUE
 121 : C     WRITE(6,101)
 122 : C     WRITE(6,1002)FM
 123 : C     WRITE(6,1002)GM
 124 : C     write(6,*)' FN'
 125 : C     WRITE(6,1002)FN
 126 : C     write(6,*)' GR'
 127 : C     WRITE(6,1002)GR
 128 : C     WRITE(6,101)
 129 :       RETURN                                                                    
 130 :  1002 FORMAT(10(1X,1PD11.4))
 131 :  1001 FORMAT(20(1X,I5))                                                         
 132 :  101  FORMAT(1X,'... SUBPB2103 ... FM,GM,FN,GR ',9(10H..........)/)
 133 : C                                                                               
 134 :       END                                                                       
 135 :  
 136 :  
 137 :  
 138 :  
 139 :  
 140 :  
 141 :  
 142 :  
 143 :  
 144 :