*TITLES1JOB  -- OBTAIN JOBNAME                                          00000001
C***********************************************************************
C                 COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991            *
C***********************************************************************
*A    AUTHOR                 H. HOOGSTRAAT                              00000002
*A    DESIGNER               H. HOOGSTRAAT                              00000003
*A    LANGUAGE               S/370 ASSEMBLER                            00000004
*A    SYSTEM                 IBM (SEE CRAY)                             00000004
*A    WRITTEN                                                           00000005
*     REVISED                                                           00000006
*A                                                                      00000007
*A                                                                      00000008
*A    CALL S1JOB (JOBNAME)                                              00000009
*A         OUTPUT JOBNAME = JOBNAME IN CHARACTERS                   A8  00000010
*A                                                                      00000020
*A                                                                      00000021
*A    THIS ROUTINE RETURNS THE NAME OF THE CURRENT JOB.                 00000030
*A                                                                      00000040
*                                                                       00000050
*        ======================================================         00000060
*               *                PROGRAM DEVELOPED BY                   00000070
*             * H *       HOOGSTRAAT PROGRAMMING SERVICES LTD.          00000080
*           * P   S *            BOX 20, SITE 7, SS #1                  00000090
*         * * * * * * *   CALGARY, ALTA.  CANADA   PH 288-8088          00000100
*        ======================================================         00000110
*                                                                       00000120
S1JOB    CSECT                                                          00000130
         COPY      S1REG                                                00000140
BASE     EQU       R4                                                   00000150
*                                                                       00000160
         STM       R2,R4,28(R13)                                        00000170
         BALR      BASE,0                                               00000180
         USING     *,BASE                                               00000190
         L         R2,0(R1)                                             00000200
         EXTRACT   (R2),FIELDS=TIOT                                     00000210
         L         R3,0(,R2)                                            00000220
         MVC       0(8,R2),0(R3)                                        00000230
         LM        R2,R4,28(R13)                                        00000240
         SR        R15,R15                                              00000250
         BR        R14                                                  00000260
         LTORG                                                          00000270
         END                                                            00000280