
C====SINGLE INTEGRATION WITH A POLE===============                      
      SUBROUTINE ONE1(OM,LAMM,RP,M,M1,RE,IM,C,Q,D1,RM)                   
      REAL*8 OM ,RE,IM,KAP,X1,X2,X3,X4,X5,                              
     *  U,V,A,B,T,XM0,XLAM,DELX,MIN,K2,K3,                              
     *  LAMM(*),RP(*),                                                  
     *  C(*),Q(*),D1(*),RM(*)                                           
      INTEGER M,M1,JJ,W,IMIN,I                                          
      IF ( M.GT.M1 ) THEN                                               
      DELX=DSQRT(LAMM(M))-DSQRT(LAMM(M-1))                              
      K3=DELX/3                                                         
      XM0=DSQRT(LAMM(M1+1))                                             
      END IF                                                            
      DO 10 I=1, M                                                      
       Q(I)=0.                                                           
       D1(I)=0.                                                          
  10  CONTINUE                                                          
       C(M1+1)=K3                                                       
      DO 110 I=M1+2, M-1, 2                                             
       C(I)=4.*K3                                                        
       C(I+1)=2.*K3                                                      
  110  CONTINUE                                                         
       C(M)=K3                                                          
      DO 120 I=1, M1                                                    
  120  C(I)=1.   
       IW=0
       DO 20 I=M1+1, M
       IF (DABS(OM-LAMM(I)).LE. 0.0001) THEN
       IW=I
C       PRINT 21,IW
C  21   FORMAT('   IW= ',I4)
       GOTO 30
       END IF                            
   20  CONTINUE 
  30   IF (IW.EQ.M1+1 ) THEN                                             
       Q(IW)=C(IW)                                                         
       Q(IW+1)=-1./2.*C(IW)                                                      
       ELSE IF (IW.EQ.M1+2) THEN                                             
       Q(IW-1)=-1./2.*C(IW)                                                         
       Q(IW)=C(IW)                                                        
       Q(IW+1)=-1./2.*C(IW)                                                      
       ELSE IF ((IW.GE.M1+3) .AND.(IW.LE.M-2))THEN  
       Q(IW-2)=1./6.*C(IW)                                                      
       Q(IW-1)=2./3.*C(IW)                                                      
       Q(IW)=C(IW)                                                         
       Q(IW+1)=2./3.*C(IW)                                                      
       Q(IW+2)=1./6.*C(IW)                    
       ELSE IF (IW.EQ.M-1) THEN
       Q(IW+1)=-1./2.*C(IW)                                                         
       Q(IW)=C(IW)                                                        
       Q(IW-1)=-1./2.*C(IW)                                                      
       ELSE
       Q(IW)=C(IW)                                                        
       Q(IW-1)=-1./2.*C(IW)                                                      
       END IF                               
 100  KAP=XM0   
       RE=0                                                             
      DO 130 W=1, M                                                     
      IF ( W.EQ.IW ) THEN
         D1(IW)=0
      ELSE
         D1(W)=1./(OM-LAMM(W))        
      END IF                        
       IF (W.GT.M1) THEN
        KAP=DSQRT(LAMM(W))
        D1(W)=2.*KAP*D1(W)
       END IF
 130  CONTINUE                                                          
C       DO 101 W=1,M                                                       
C       PRINT 102,IW,C(W),Q(W),D1(W),RP(W)
C  102  FORMAT(I5,4E15.8)
C  101  CONTINUE
      DO 140 JJ=1, M                                                    
        RM(JJ)=RP(JJ)*(C(JJ)-Q(JJ))*D1(JJ)                              
       RE=RE+RM(JJ)                                                     
  140  CONTINUE                                                         
       IM=0                                                             
       KAP=XM0                                                          
       MIN=OM-KAP**2                                                    
      IF ( MIN.GT.0 )MIN=DABS(MIN)                                      
      IF ( MIN.LE.0 )GOTO 150                                           
      DO 160 I=M1+1, M                                                  
      IF (DABS(OM-KAP**2).LE.MIN ) THEN                                 
       IMIN=I                                                           
       MIN=DABS(OM-KAP**2)                                              
       END IF                                                           
       KAP=KAP+DELX                                               
  160  CONTINUE
C       IM=-RP(IMIN)*3.1416                                              
       IM=-RP(IW)*3.1416                                              
  150  RETURN                                                           
      END                                                               
