FTN4,L
      SUBROUTINE CLONE(IDCB,OLDNAM,NEWNAM,OLDID,NEWID,IER,IFMPER) 
     C,92067-16125 REV.1903 790420
      INTEGER IDCB(144),OLDNAM(3),NEWNAM(3),OLDID 
C 
C 
C  ***************************************************************
C  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS     *
C  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
C  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
C  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
C  ***************************************************************
C 
C 
C           NAME:   CLONE 
C           SOURCE: 92067-18464 
C           RELOC:  92067-16125 
C           PGMR:   C.M.M.
C 
C 
C 
C 
C  THE CLONE SUBROUTINE IS CALLED TO DO WHATEVER IT TAKES TO CLONE
C  AN ID SEGMENT. 
C 
C 
C 
C    ON RETURN :   IER  = 1     SUCCESS 
C 
C                  IER  = 2     THE PROGRAM YOU NAMED WAS ALREADY CLONED AND
C                               HAS AN ID SEGMENT. HOWEVER, THAT PROGRAM
C                               IS BUSY.  THAT IS IF YOU WISH TO
C                               RUN IT USE THE EXEC 23 OR 24.  ALTERNATELY
C                               IF YOUR SURE YOU KNOW WHAT YOUR DOING 
C                               ABORT THE PROGRAM (OF,XXXXX,1) AND THEN 
C                               YOU CAN SCHEDULE IT.   ALTERNATELY YOU
C                               MIGHT PICK A DIFFERENT NAME ,SAY XX.LU, 
C                               AND TRY THAT NAME.  HOWEVER, KEEP IN MIND 
C                               THAT THE SESSION ALREADY HAS ONE CLONE OF 
C                               THE PROGRAM.
C 
C                  IER  = 3     DUPLICATE PROGRAM NAME.  THAT IS THE NAME 
C                               YOU GAVE ME IS ALREADY IN THE SYSTEM AND
C                               IS NOT A CLONE OF THE PROGRAM YOU SPECIFIED 
C                               FOR EXAMPLE PROGRAM ABCDE IS WHAT YOU 
C                               WISHED CLONED TO ABCLU. HOWEVER, A PROGRAM
C                               CALLED ABCPQ HAS ALREADY BEEN CLONED TO 
C                               ABCLU.
C                               WHAT YOU MIGHT WANT TO DO AT THIS POINT IS
C                               PICK A DIFFERENT NAME AN TRY THIS SUBROUTINE
C                               AGAIN.  WHY DON'T YOU CALL IT AB.LU .  IF 
C                               THAT DOESN'T WORK YOU COULD TRY SCHEDULING
C                               THE ORGINAL PROGRAM.  RECALL THAT THE 
C                               ID ADDRESS OF THE ORGINAL PROGRAM IS
C                               RETURNED, IF IT IS 0, THEN YOU CAN CALL THIS
C                               SUBROUTINE TO RP THE ORGINAL PROGRAM.  IF 
C                               THAT DOESN'T WORK YOU ARE S.O.L. ISSUE A
C                               'DUPLICATE PROGRAM ERROR MESSAGE & FORGET 
C                                IT.
C 
C                 IER  = 4      SYSTEM OUT OF ID SEGMENTS.  YOU MIGHT TRY 
C                               TO SCHEDULE THE ORGINAL IF IT'S IN MEMORY.
C                               REMEMBER I RETURN THE ORGINAL'S ID ADDRESS
C                               IF HE IS IN MEMORY. 
C 
C                 IER  = 5      PROGRAM NOT FOUND.  IE I COULDN'T FIND IT 
C                               ANYWHERE ON LU 2 OR LU 3 OR ANYPLACE. 
C 
C                 IER  = 6      OPEN ERROR.  I WENT OUT TO LU2 OR LU3 
C                               TO FIND THE PROGRAM & DID INDEED FIND IT. 
C                               HOWEVER, WHEN I WENT TO OPEN THAT FILE TO 
C                               CREATE THE ID SEGMENT AN FMP ERROR OCCURED. 
C                               THE ERROR WILL BE IN THE IFMPER PARAMETER.
C 
C                 IER  = 7      CLOSE ERROR.  FOUND THE PROGRAM ON THE DISC 
C                               BUT WHEN I CLOSED THE FILE AN FMP ERROR 
C                               OCCURED.  THE ERROR WILL BE IN IFMPER.
C 
C                 IER  = 8      CHECKSUM ERROR.  THE PROGRAM WAS FOUND ON 
C                               THE DISC BUT WITH A CHECKSUM ERROR.  THE
C                               PROGRAM WAS PROBABLY NOT LOADED ON THIS 
C                               SYSTEM. 
C 
C                 IER  = 9      THIS PROGRAM CAN'T BE COPIED. THAT IS IT
C                               WAS LOADED WITH THE DON'T COPY OPTION.
C 
C                 IER  = 10     ILLEGAL PROGRAM NAME.  IE WHO DO YOU THINK
C                               YOU KIDDING WITH A PROGRAM NAME LIKE THAT.
C 
C 
C 
C***********************************************************************
C 
C 
C 
C           OK CLEAR OUT A FEW WORDS
C 
      IFMPER = 0
      NEWID = 0 
C 
C                  SEE IF THE ORGINAL PROGRAM IS RP'D 
C 
      OLDID = IDSGA(OLDNAM) 
      IF(OLDID.EQ.0) GO TO 500
      CALL IDDUP(OLDNAM,NEWNAM,IERX)
      GO TO 600 
C 
C           WELL THE PROGRAM ASKED FOR WAS NOT IN MEMORY SO LETS SEE IF 
C           WE CAN FIND IT ON THE DISC. 
C 
C 
C 
500   CALL OPEN(IDCB,IFMPER,OLDNAM,1,0,-2)
      IF(IFMPER .EQ. -6) CALL OPEN(IDCB,IFMPER,OLDNAM,1,0,-3) 
      IF((IFMPER .EQ.-6).OR.(IFMPER.EQ. -32)) GO TO 1050
      IF(IFMPER .LT. 0) GO TO 1060
C 
C            WE FOUND IT !   SO DUPLICATE THE ID. 
C 
      CALL IDRPL(IDCB,IERX,NEWNAM)
      CALL CLOSE(IDCB,IFMPER) 
C 
      IF (IFMPER .LT.0) GO TO 1070
C 
600   IF (IERX .EQ. 0) GO TO 999
C 
C            WE SEEM TO HAVE A PROBLEM
C 
700   IF (IERX .EQ. 19) IER = 8 
      IF (IERX .EQ. 14) IER = 4 
      IF (IERX .EQ. 23) IER = 3 
      IF (IERX .EQ. 17) IER = 9 
      IF (IERX .EQ.-15) IER = 10
C 
C                YOU LOSE TURKEY !!!!!!!!!!!!!
C 
      RETURN
C 
999   IER = 1 
      NEWID = IDSGA(NEWNAM) 
      IF(IAND(IXGET(NEWID + 15),7) .NE. 0) IER = 2
C 
C     SUCCESS !!!!!!!!!!!!!!!!!!!!!!!!
C 
      RETURN
C 
C 
1050  IER = 5 
      RETURN
1060  IER = 6 
      RETURN
1070  IER = 7 
      RETURN
      END 
      END$
                                                                                                          