ADAS Subroutine rbesf

C
       FUNCTION RBESF(LAM,Q,X)                                          
       IMPLICIT REAL*8(A-H,O-Z)                                         
C
C  PURPOSE: EVALUATES HALF INTEGER BESSEL FUNCTION                      
C
C  RBESF=(J(LAM,Q*X)-DELTA(LAM,0))/Q**2                                 
C-------------------------------------------------------------------------
C
C  VERSION  : 1.1                          
C  DATE     : ?
C  MODIFIED : H P Summers 
C              - Initial version. 
C
C  VERSION  : 1.2                          
C  DATE     : 16-05-2007
C  MODIFIED : Allan Whiteford
C              - Remove listing information from colums 72+. 
C              - Updated comments as part of subroutine documentation
C	         procedure.
C-------------------------------------------------------------------------
       Z=Q*X                                                            
       XLAM=LAM                                                         
       IF(Z.LE.1.0D0)GO TO 25                                           
       Z0=1.570796*XLAM                                                 
       SN=DSIN(Z-Z0)                                                    
       CS=DCOS(Z-Z0)                                                    
       T=1.0                                                            
       RBESF=T*SN                                                       
       I=0                                                              
       IC=1                                                             
    5  I=I+1                                                            
       XI=I                                                             
       T=T*(XLAM+XI)*(XLAM-XI+1.0)/(XI*2.0*Z)                           
       IF(DABS(T).LE.1.0D-7)GO TO 20                                    
       GO TO (10,15),IC                                                 
   10  RBESF=RBESF+T*CS                                                 
       T=-T                                                             
       IC=2                                                             
       GO TO 5                                                          
   15  RBESF=RBESF+T*SN                                                 
       IC=1                                                             
       GO TO 5                                                          
   20  RBESF=RBESF/Z                                                    
       IF(LAM.LE.0)RBESF=RBESF-1.0D0                                    
       RBESF=RBESF/(Q*Q)                                                
   60  RETURN                                                           
   25  T=1.0                                                            
       IF(LAM.LE.0)GOTO 36                                              
       DO 35 I=1,LAM                                                    
       XI=I                                                             
   35  T=T/(2.0*XI+1.0)                                                 
       T=T*X*X                                                          
       IF(LAM.NE.2)T=T*Z**(LAM-2)                                       
       I=0                                                              
       GO TO 37                                                         
   36  T=-(X*X)/6.0D0                                                   
       I=1                                                              
   37  RBESF=T                                                          
       Z2=0.5*Z*Z                                                       
   40  I=I+1                                                            
       XI=I                                                             
       T=-T*Z2/(XI*(2.0*(XLAM+XI)+1.0))                                 
       IF(DABS(T).LE.1.0D-7)GO TO 60                                    
       RBESF=RBESF+T                                                    
       GO TO 40                                                         
      END                                                               
      INTEGER             LAM
      REAL*8              Q,           X