CTITLESAPK24 - 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 = PICKJ               00080000
C                                                                       00090000
C                                                                       00100000
C     SUBROUTINE PICKJ(JJ,J,ISHT,JSHT,N2,YC,YY,KPBUGF,KP,IPR,IT1,JPOS,  00110000
C                                                                       00120000
      SUBROUTINE SAPK24(JJ,J,ISHT,JSHT,N2,YC,YY,KPBUGF,KP,IPR,IT1,JPOS, 00130000
     +                 LPOS,MM,I20,I20M)                                00140000
C                                                                       00150000
      DIMENSION ISHT(1),JSHT(I20,1),YC(1),YY(I20,1),IT1(I20,1),         00160000
     +          JPOS(1),LPOS(1)                                         00170000
C                                                                       00180000
      JJ=J                                                              00190000
C                                                                       00200000
      CALL ARMVE(ISHT,JSHT,I20M)                                        00210000
      CALL ARMVE(YC,YY,I20M)                                            00220000
      CALL ARMVE(JPOS,LPOS,I20M)                                        00230000
C                                                                       00240000
      IF(KPBUGF.LE.KP) RETURN                                           00250000
C                                                                       00260000
      K=1                                                               00270000
      WRITE(IPR,1001)J,N2,(JSHT(I,K),IT1(I,K),YY(I,K),I=1,N2)           00280000
 1001 FORMAT(18X,2I5,7X,8('|',I3,I2,F6.3)/(35X,8('|',I3,I2,F6.3)))      00290000
      DO 1002 K=2,MM                                                    00300000
 1002 WRITE(IPR,1003)     (JSHT(I,K),IT1(I,K),YY(I,K),I=1,N2)           00310000
 1003 FORMAT(35X,8('|',I3,I2,F6.3)/(35X,8('|',I3,I2,F6.3)))             00320000
C                                                                       00330000
      RETURN                                                            00340000
C                                                                       00350000
      END                                                               00360000