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