      SUBROUTINE IMAGE_NAME (NAME)                                      00051 
      IMPLICIT NONE                                                     00053 
      INCLUDE ' 32766 .FID/NOLIST'                                      00053 
      INCLUDE '($JPIDEF)/NOLIST'                                !860407 00055 
      INTEGER*4 GETJPILST(4)   !LOC, R/W, $GETJPI argument list         00057 
      INTEGER*2 GETJPILST_W(8) !LOC, R/W, EQUIV (GETJPILST,GETJPILST_W) 00058 
      INTEGER*2 I              !LOC, R/W, scratch                       00059 
      INTEGER*2 IMAGE_END      !LOC, R/W, last char in file name        00060 
      INTEGER*2 IMAGE_STRT     !LOC, R/W, 1st char in file name         00061 
      CHARACTER*256 IMAGE_NAM  !LOC, R/W, image file name               00062 
      INTEGER*4 IMAGE_NAM_LEN  !LOC, R/W, # characters in IMAGE_NAM     00063 
      INTEGER*2 J              !LOC, R/W, scratch                       00064 
      CHARACTER*(*) NAME       !EXT, R/W, output image name             00066 
      INTEGER*2 NAME_LEN       !LOC, R/W, # characters in NAME          00067 
      EQUIVALENCE (GETJPILST,GETJPILST_W)                               00069 
      GETJPILST_W(1) = LEN(IMAGE_NAM)           !Max length             00071 
      GETJPILST_W(2) = JPI$_IMAGNAME            !Action code    !860407 00072 
      GETJPILST(2)   = %LOC(IMAGE_NAM)  !Addr of output                 00073 
      GETJPILST(3)   = %LOC(IMAGE_NAM_LEN)      !Addr of output length  00074 
      GETJPILST(4)   = 0                        !end of list            00075 
      CALL SYS$GETJPI(%VAL(0),,,GETJPILST,,,)                           00077 
      CALL SYS$WAITFR(%VAL(0))                                          00078 
D     TYPE*,'IMAGE_NAME: LEN=',IMAGE_NAM_LEN,' IMAGE_NAM=',IMAGE_NAM    00080 
      I=IMAGE_NAM_LEN           !Find period before extension           00084 
      DOWHILE(I.GT.0 .AND. IMAGE_NAM(I:I).NE.'.')                       00085 
      I=I-1                                                             00085 
      ENDDO                                                             00085 
      IMAGE_END=I-1                                                     00086 
      DOWHILE(I.GT.0 .AND. IMAGE_NAM(I:I).NE.']')                       00088 
      I=I-1                                                             00088 
      ENDDO                                                             00088 
      IMAGE_STRT=I+1            !Just after ] in directory              00089 
      NAME_LEN = LEN(NAME)                                              00091 
      IF(IMAGE_STRT.GT.IMAGE_END)THEN                                   00093 
      DO I=1,NAME_LEN                                                   00094 
      NAME(I:I)=' '   !Blank fill                                       00094 
      ENDDO                                                             00094 
      ELSE                                                              00096 
      J=1                                                               00098 
      I=IMAGE_STRT                                                      00099 
      DOWHILE(I.LE.IMAGE_END .AND. J.LE.NAME_LEN)                       00100 
      NAME(J:J)=IMAGE_NAM(I:I)                                          00101 
      J=J+1                                                             00102 
      I=I+1                                                             00103 
      ENDDO                                                             00104 
      IF(J.LE.NAME_LEN)THEN                                             00105 
      DO I=J,NAME_LEN                                                   00106 
      NAME(I:I)=' '   !Blank fill                                       00106 
      ENDDO                                                             00106 
      ENDIF                                                             00107 
      ENDIF                                                             00108 
      RETURN                                                            00110 
      END                                                               00111 
