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