      SUBROUTINE S4
      IMPLICIT REAL*8(A-H,O-Z)
      COMMON/GEOM1/XB(240),RB(240),RBP(240),C2,BET
      COMMON/DATA1/C(240),C1(240),B(240),C3
      COMMON/DFO/FIO,FIOX,FIOR,FIOXX,FIOXR,FIORR
      COMMON/DF1/FI1,FI1X,FI1R,XIOX,XIOR
      COMMON/DISC/R1,PI,I,JH,J,KL
      BETA=BET
      CT=R1*C(J)
      C1T=R1*C1(J)
      BT=R1*B(J)
      X=XB(I)-XB(J-1)+BETA*RB(J-1)
      T=BETA*RB(I)/X
      IF(T.GT.0.999999D0) T=0.999999D0
      T2=T**2
      F2=DSQRT(1.D0-T2)
      F3=F2/T
      F1=DLOG(1.D0/T+F3)
      F5=X*(F3-T*F1)
      F6=2.D0*X*(F1-F2)
      F7=-BETA*(F3/T+F1)
      FIO=FIO+0.5D0*CT*X*(T*F5-F6)
      FIOX=FIOX-CT*F6
      FIOR=FIOR+BETA*CT*F5
      FIOXX=FIOXX-2.D0*CT*F1
      FIOXR=FIOXR+2.D0*BETA*CT*F3
      FIORR=FIORR+BETA*CT*F7
      FI1=FI1+0.5D0*BT*F5
      FI1X=FI1X+BT*F3
      FI1R=FI1R+0.5D0*BT*F7
      XIOX=XIOX-C1T*F6
      XIOR=XIOR+BETA*C1T*F5
      RETURN
      END
      
