Esope source files

   1 : C FOBEJ0    SOURCE    CHAT      05/01/13    00:05:28     5004           
   2 :       SUBROUTINE  FOBEJ0(XR1,NXR1,XR2)                                          
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
   5 : C                                                                               
   6 : C  XR1( NXR1) : TABLEAU DE REELS TOUS >-3                                       
   7 : C  XR2( NXR1) : TABLEAU DE REELS                                                
   8 : C                                                                               
   9 : C           XR2(I) = J0 (  XR1(I) )                                             
  10 : C      J0 FONCTION DE BESSEL DE PREMIERE ESPECE D'ORDRE 0                       
  11 : C                                                                               
  12 : C       APPROXIMATION POLYNOMIALE PAR SECTEUR                                   
  13 : C       REFERENCE : ABRAMOWITZ HANDBOOK OF MATHEMATICAL FONCTIONS               
  14 : C       PRECISION  E = 1.E-8                                                    
  15 : C                                                                               
  16 :       DIMENSION XR1(NXR1)                                                       
  17 :       DIMENSION XR2(NXR1)                                                       
  18 : C                                                                               
  19 :       A0=         1.D0                                                          
  20 :       A2= -2.2499997D0                                                          
  21 :       A4=  1.2656208D0                                                          
  22 :       A6=  -.3163866D0                                                          
  23 :       A8=   .0444479D0                                                          
  24 :       A10= -.0039444D0                                                          
  25 :       A12=  .0002100D0                                                          
  26 : C                                                                               
  27 :       B0=  .79788456D0                                                          
  28 :       B1= -.00000077D0                                                          
  29 :       B2= -.00552740D0                                                          
  30 :       B3= -.00009512D0                                                          
  31 :       B4=  .00137237D0                                                          
  32 :       B5= -.00072805D0                                                          
  33 :       B6=  .00014476D0                                                          
  34 : C                                                                               
  35 :       C0= -.78539816D0                                                          
  36 :       C1= -.04166397D0                                                          
  37 :       C2= -.00003954D0                                                          
  38 :       C3=  .00262573D0                                                          
  39 :       C4= -.00054125D0                                                          
  40 :       C5= -.00029333D0                                                          
  41 :       C6=  .00013558D0                                                          
  42 : C                                                                               
  43 :       DO 100  I=1,NXR1                                                          
  44 :         IF ( XR1(I) .LE.3D0) THEN                                               
  45 :           Y= XR1(I) / 3D0                                                       
  46 :           XR2(I) = A0 + (A2 * (Y**2))+ ( A4 * (Y**4 )) + (A6 * (Y**6 ))         
  47 :      &                + (A8 * (Y**8))+ ( A10* (Y**10)) + (A12* (Y**12))         
  48 :         ELSE                                                                    
  49 :           Y= 3D0/XR1(I)                                                         
  50 :           F0 = B0 + (B1 * Y)+ ( B2 * (Y**2 )) + (B3 * (Y**3 ))                  
  51 :      &            + (B4 * (Y**4))+ ( B5* (Y**5)) + (B6* (Y**6))                 
  52 :           T0 =  XR1(I)+C0 + (C1 * Y)+ ( C2 * (Y**2 )) + (C3 * (Y**3 ))          
  53 :      &            + (C4 * (Y**4))+ ( C5* (Y**5)) + (C6* (Y**6))                 
  54 :           XR2(I) = (1. / ( XR1(I) ** .5)) * F0 * COS(T0)                        
  55 :         ENDIF                                                                   
  56 : 100   CONTINUE                                                                  
  57 : C                                                                               
  58 :       RETURN                                                                    
  59 :       END                                                                       
  60 :