      SUBROUTINE GETKPR(LEN, LB, LE, LM, SGB, SIG, KPR, SGD
Status: R

     *,                          WK1, ISN, IW1, IW2)
C
      DIMENSION SIG(LEN,LM), KPR(LEN,LM), SGD(LEN,LM), SGB(LM)
     *,         SGBF(100),   WK1(LEN),    ISN(LEN)
     *,         IW1(LEN),    IW2(LEN),    WK2(LEN)
      LOGICAL FIRST
      DATA FIRST/.TRUE./
C
      IF (FIRST) THEN
         FIRST = .FALSE.
         DO 10 L=1,LM
         SGBF(LM+L) = SGB(L)
         SGBF(L)    = 1000.0
         SGBF(LM+LM+L) = 1001.0
   10    CONTINUE
      ENDIF
C
C
      DO 100 L=1,LM
      if (LB .EQ. 1) THEN
         IF (LE .EQ. LEN) THEN
            WK1(:) = -SGD(:,L)
         else
            DO 15 I=1,LE
            WK1(i) = -(SGD(I,L)+SGD(I+LEN-LE,L)) * 0.5
   15       CONTINUE
         endif
      ELSE
        DO 17 I=LB,LE
        WK1(i) = -(SGD(I,L)+SGD(I+1,L)) * 0.5
   17   CONTINUE
      ENDIF
C
c      print *,' sgd=',sgd(221,L),' SIG=',SIG(221,L),' wk1=',wk1(221)
      DO 20 I=LB,LE
C      WK1(I)   = - SGD(I,L)
C      ISN(I)   = SIGN(WK1(I), 1.0)
      ISN(I)   = NINT(SIGN(1.0, WK1(I)))
      KPR(I,L) = L + (ISN(I)-1)/2
      WK1(I)   = SIG(I,L) - SGB(L)
      IW1(I)   = (1 + ISN(I)) / 2
      IW2(I)   = (1 - ISN(I)) / 2
   20 CONTINUE
c      print *,' isn=',(isn(i),i=1,1000)
c      print *,' iw1=',(iw1(i),i=1,1000)
c      print *,' iw2=',(iw2(i),i=1,1000)
C
      K = 1
C
   30 CONTINUE
      NCOUNT = 0
C
      RPK = 1.0 / (SGBF(LM+L+K) - SGB(L))
      RMK = 1.0 / (SGBF(LM+L-K) - SGB(L))
C
      DO 50 I=LB,LE
      TPK = WK1(I) * RPK
      TMK = WK1(I) * RMK
      ITK = IW1(I) * TPK + IW2(I) * TMK
      ITK = MIN0(ITK, 1)
c      if (itk .lt. 0) then
c         print *,' itk=',itk,' tpk=',tpk,' tmk=',tmk
c     *,       ' wk1=',wk1(i),' rpk=',rpk,' rmk=',rmk
c     *,       ' iw1=',iw1(i),' iw2=',iw2(i),' isn=',isn(i),' i=',i
c         stop
c      endif
      KPR(I,L) = KPR(I,L) + ISN(I) * ITK
      NCOUNT   = NCOUNT + ITK
   50 CONTINUE
C
      K = K + 1
      IF (NCOUNT .GT. 0) GO TO 30
C
c      print *,' l=',l,' ncount=',ncount,' k=',k
      min1 = 1000
      max1 = -1000
      do 60 i=1,len
      min1 = min(kpr(i,l),min1)
      max1 = max(kpr(i,l),max1)
   60 continue
      print *,' min1=',min1,' max1=',max1
c      write (6,101) (kpr(i,l),i=1,500)
c  101 format(' kpr=',20i4)
  100 CONTINUE
C
c      if (LM .eq. 16) stop
      RETURN
      END 


