CTITLESAPK26 - SUBROUTINE USED BY SDPICK                                00010000
C***********************************************************************
C                 COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991            *
C***********************************************************************
CA                                                                      00020000
CA   DESIGNER             P. C. LUH                                     00030000
CA   AUTHOR               P. C. LUH                                     00040000
CA   LANGUAGE             FORTRAN                                       00050000
CA   SYSTEM               IBM  ONLY                                     00060000
CA   DATE                 MM/DD/YY                                      00070000
C    REVISED              03/06/86  LBL  OLD NAME = PICKL               00080000
C                                                                       00090000
C                                                                       00100000
C     SUBROUTINE PICKL(IPR,TK,I20,TWK,I20M,I,KT1,                       00110000
C                                                                       00120000
      SUBROUTINE SAPK26(IPR,TK,I20,TWK,I20M,I,KT1,                      00130000
     +                 J,KPBUGF,KP,WK,                                  00140000
     +                 IK,N2,JSHT,YY,JJ,T3,YC,TWKJJ,T2,TOLR2,           00150000
     +                 IT1,ISHT,NPOS,LPOS,JPOS,JSHTJJ,YYJJ,LPOSJJ,CONS, 00160000
     +                 MM,KK,MSHT,IRP2,RP1,JM,I400,ILHT,EX,NSHT,KK1,JJM,00170000
     +                 IT1JJ,IERR)                                      00180000
C                                                                       00190000
      DIMENSION TWK(1),JSHT(1),YY(1),T3(1),YC(1),TWKJJ(1),IT1(1),KT1(1),00200000
     +          ISHT(1),LPOS(1),JPOS(1),JSHTJJ(1),YYJJ(1),LPOSJJ(1),    00210000
     +          MSHT(1),IRP2(1),WK(1),RP1(1),JM(1),ILHT(1),EX(1),       00220000
     +          NSHT(1),JJM(1),IT1JJ(1)                                 00230000
C                                                                       00240000
C     CALL       PICKI(N2,NPOS,TWK,TK,JJ,JK,KPBUGF,KP,IPR,              00250000
      CALL      SAPK23(N2,NPOS,TWK,TK,JJ,JK,KPBUGF,KP,IPR,              00260000
     +                 T3,YC,TWKJJ,TOLR2,IT1,ISHT,J,N1,JPOS,            00270000
     +                 JSHTJJ,YYJJ,LPOSJJ,CONS,MM,I20,KK,MSHT,WK,IRP2,  00280000
     +                 RP1,JM,I400,ILHT,EX,NSHT,KK1,I20M,JJM,IT1JJ,IERR)00290000
C                                                                       00300000
      IF(IERR.EQ.0) RETURN                                              00310000
C                                                                       00320000
      IF(JK/MM.LT.N2) GO TO 650                                         00330000
C                                                                       00340000
      KT1(I)=-KT1(I)                                                    00350000
C                                                                       00360000
      N2=N1                                                             00370000
      T2=-3.                                                            00380000
      T3(J)=-3.                                                         00390000
      RETURN                                                            00400000
                                                                        00410000
  650 CONTINUE                                                          00420000
C                                                                       00430000
      KK=KK+1                                                           00440000
      KK1=KK1+1                                                         00450000
C                                                                       00460000
C     CALL       PICKJ(JJ,J,ISHT,JSHT,N2,YC,YY,KPBUGF,KP,IPR,IT1,JPOS,  00470000
      CALL      SAPK24(JJ,J,ISHT,JSHT,N2,YC,YY,KPBUGF,KP,IPR,IT1,JPOS,  00480000
     +                 LPOS,MM,I20,I20M)                                00490000
C                                                                       00500000
      RETURN                                                            00510000
C                                                                       00520000
      END                                                               00530000