Esope source files

   1 : C PB201     SOURCE    MAGN      10/05/18    21:16:30     6675           
   2 :       SUBROUTINE PB201(XREF,X,PG,FN,GR,FM,GM,ND,NP,MP,NG,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 : SEG2                                
   8 : C                                                                               
   9 : C                                                                               
  10 : C************************************************************************       
  11 :                                                                                 
  12 :       REAL*8 X(NPG),XREF(ND,NP)
  13 :       REAL*8 FN(NP,NPG),GR(ND,NP,NPG),PG(NPG)                                   
  14 :       REAL*8 FM(MP,NPG),GM(ND,MP,NPG)
  15 :       REAL*8 A,B,C,D,U(5),H(5)
  16 :       CHARACTER*4 NOM2
  17 : C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>        
  18 : 
  19 :       XREF(1,1)=0.D0
  20 :       XREF(1,2)=1.D0
  21 : 
  22 :       NP2=NP*ND                                                                 
  23 : 
  23 :       CALL CALUHG(U,H,NG)                                                       
  24 :       A=0.D0                                                                    
  25 :       B=1.D0                                                                    
  26 :       IF(ITYPI.EQ.2)THEN
  27 :       X(1)=0.D0
  28 :       X(2)=1.D0
  29 :       PG(1)=0.5D0
  30 :       PG(2)=0.5D0
  31 :       ELSE
  31 :       CALL CALG1(A,B,NG,H,U,X,PG)                                               
  32 :       ENDIF
  33 :       DO 1 L=1,NPG                                                              
  34 : C                                                                               
  35 :       FN(1,L)=1.D0-X(L)                                                         
  36 :       FN(2,L)=X(L)                                                              
  37 :       GR(1,1,L)=-1.D0                                                           
  38 :       GR(1,2,L)=1.D0                                                            
  39 :  1    CONTINUE                                                                  
  40 : 
  41 :       IF(MP.EQ.1)THEN
  42 :       DO 2 L=1,NPG
  43 :       FM(1,L)=1.D0
  44 :       GM(1,1,L)=0.D0
  45 :  2    CONTINUE
  46 : 
  47 :       ENDIF
  48 :       IF(NOM2.EQ.'P1P1')THEN
  49 :       DO 3 L=1,NPG
  50 :       FM(1,L)=FN(1,L)
  51 :       FM(2,L)=FN(2,L)
  52 :       GM(1,1,L)=GR(1,1,L)
  53 :       GM(2,1,L)=GR(2,1,L)
  54 :       GM(1,2,L)=GR(1,2,L)
  55 :       GM(1,2,L)=GR(1,2,L)
  56 :  3    CONTINUE
  57 :       ENDIF
  58 : 
  59 : C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>        
  60 : C     WRITE(6,101)
  61 : C     WRITE(6,1002)FN
  62 : C     WRITE(6,1002)GR
  63 : C     WRITE(6,101)
  64 :       RETURN                                                                    
  65 :  1002 FORMAT(10(1X,1PD11.4))                                                    
  66 :  1001 FORMAT(20(1X,I5))                                                         
  67 :  101  FORMAT(1X,'... SUB PB201 ... FN,GR,FX,GX ',9(10H..........)/)             
  68 : C                                                                               
  69 :       END                                                                       
  70 :  
  71 :  
  72 :  
  73 :  
  74 :  
  75 :  
  76 :