Esope source files

   1 : C BB302     SOURCE    MAGN      10/05/31    21:15:00     6679           
   2 :       SUBROUTINE BB302(XREF,XCOPG,XPOPG,
   3 :      $     FFPGV,DFFPGV,
   4 :      $     FFPGP,DFFPGP,
   5 :      $     X,Y,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 : TRI4   P1 + bulle P1
  11 : C                                              ou  P1 + bulle P0
  12 : C     ^ eta
  13 : C     |
  14 : C   a |n3
  15 : C     |\
  16 : C     | \     a=sqrt(2)
  17 : C     |n4\
  18 : C     |___\ _____>ksi
  19 : C     0   a
  20 : C     n1  n2
  21 : C                                                                               
  22 : C                                                                               
  23 : C************************************************************************       
  24 : * Entrées
  25 :       INTEGER ND,NP,MP,NPG
  26 : *
  27 :       REAL*8 XREF(ND,NP)
  28 :       REAL*8 XCOPG(ND,NPG)
  29 :       REAL*8 XPOPG(NPG)
  30 :       REAL*8 FFPGV(NP,NPG)
  31 :       REAL*8 DFFPGV(NP,ND,NPG)
  32 :       REAL*8 FFPGP(MP,NPG)
  33 :       REAL*8 DFFPGP(MP,ND,NPG)
  34 : * Sorties
  35 :       REAL*8 X(NPG),Y(NPG)
  36 :       REAL*8 PG(NPG)
  37 :       REAL*8 FN(NP,NPG),GR(ND,NP,NPG)
  38 :       REAL*8 FM(MP,NPG),GM(ND,MP,NPG)
  39 : * Travail
  40 :       INTEGER IPG,IP,ID
  41 :       REAL*8 UNSVOL,USVUSD
  42 : C***                                                                            
  43 :       A=SQRT(2.D0)
  44 :       XREF(1,1)=0.D0
  45 :       XREF(2,1)=0.D0
  46 :       XREF(1,2)=A
  47 :       XREF(2,2)=0.D0
  48 :       XREF(1,3)=0.D0
  49 :       XREF(2,3)=A
  50 :       XREF(1,4)=A/3.D0
  51 :       XREF(2,4)=A/3.D0
  52 : 
  53 : * magn veut que les volumes de ses éléments fasse 1
  54 :       UNSVOL=2.D0
  55 :       USVUSD=UNSVOL**(1.D0/DBLE(ND))
  56 : * Recopie des points de Gauss      
  57 :       DO 1 IPG=1,NPG
  58 :          X(IPG)=XCOPG(1,IPG)*USVUSD
  59 :          Y(IPG)=XCOPG(2,IPG)*USVUSD
  60 :          PG(IPG)=XPOPG(IPG)*UNSVOL
  61 :  1    CONTINUE
  62 : * Recopie des fns. de forme vitesse
  63 :       DO 3 IPG=1,NPG
  64 :          DO 32 IP=1,NP
  65 :             FN(IP,IPG)=FFPGV(IP,IPG)
  66 :             DO 322 ID=1,ND
  67 :                GR(ID,IP,IPG)=DFFPGV(IP,ID,IPG)
  68 :  322        CONTINUE
  69 :  32      CONTINUE
  70 :  3    CONTINUE
  71 : * Recopie des fns. de forme pression
  72 :       DO 5 IPG=1,NPG
  73 :          DO 52 IP=1,MP
  74 :             FM(IP,IPG)=FFPGP(IP,IPG)
  75 :             DO 522 ID=1,ND
  76 :                GM(ID,IP,IPG)=DFFPGP(IP,ID,IPG)
  77 :  522        CONTINUE
  78 :  52      CONTINUE
  79 :  5    CONTINUE
  80 : C     WRITE(6,101)
  81 : C     WRITE(6,1002)FM
  82 : C     WRITE(6,1002)GM
  83 : C     WRITE(6,1002)FN
  84 : C     WRITE(6,1002)GR
  85 : C     WRITE(6,101)
  86 :       RETURN                                                                    
  87 :  1002 FORMAT(10(1X,1PD11.4))                                                    
  88 :  1001 FORMAT(20(1X,I5))                                                         
  89 :  101  FORMAT(1X,'... SUBPB302 ... FM,GM,FN,GR ',9(10H..........)/)              
  90 : C                                                                               
  91 :       END                                                                       
  92 :  
  93 :  
  94 :  
  95 :  
  96 :  
  97 :  
  98 :