/	SUBROUTINE CUBEOUT (KBAND,JFCB,CBUF, BUF,IRET)0C_Title  CUBEOUT.FOR output cube using  NIMSLIBXCC_Args B	INTEGER*4 KBAND		!in. control code. -n=open, kband=write, 0=close-C				! CALL SEQUENCE MUST BE: [-N],-1, M*+N,0C	INTEGER*4 JFCB(256)	!in. file control block. must not change laterD	CHARACTER*(*) CBUF	!IN. ITEMS FOR CUBE LABEL. ignored when KBAND>0."CC			! @-3=NOTE(1:64)   [optional]"CC			! @-2=CORNAM(1:16) [optional]8CC			! @-1=File_name(1:64), or leading blank for default&	INTEGER*2 BUF(*)	!in. data to write. 'C		  @KBAND=-1, MANY CONTROLS, SEE CODE,	INTEGER*4 IRET		!Out. Return code. 0=normal#C_Desc crude creation of  ISIS cubeCC_Lims$C	messages direct to spooled printerC	serious errors cause a  STOPC6C_Calls  NIMSLIBX>  CRQLAB,OPCUBE,DSPLAB,PTIMAG,CLCUBEC<C_Hist	26may88  Bob mehlman ucla/igpp  Quick & dirty version#C	88may28  HKIEFFER  USGS_FLAGSTAFF C	88jun02  HHK incorporate  CBUFC_End7      CHARACTER*64 JFILE /'CUBEOUT.CUB'/	! @-1,filename6      CHARACTER*1024 JLABEL			! limited 2-block label*4      CHARACTER*1024 HISTRY			!  DUMMY - unused, yetJ      CHARACTER*8 AXNAME(3) /'SAMPLE','LINE','BAND'/	! for band sequential?      CHARACTER*16 CORNAM /'SCALED_SUMMED_DN'/	! @-2, item name1      CHARACTER*8 CORTYP /'INTEGER'/		! item typeH      CHARACTER*64 NOTE	/'"written by  CUBEOUT"'/! @-3, output cube note4      INTEGER*4 JSBSPC(2,4)			!  DUMMY - unused, yet%	INTEGER*4 JDIM(3)			! dimen. of cube0      DATA LKP /26/				!  FCB loc of endlab(tmp)4      DATA MAXLAB /1024/			! max label bytes  (TEMP)"      CHARACTER*1 CR,LF				!  TEMP	IPT=LEN(CBUF)+	IF (KBAND.GT.0) GOTO 3000	!write one band.'	IF (KBAND.EQ.0) GOTO 4000	!close file.!	IF (KBAND.EQ.-1) THEN		!initiate'	JEXCL=-32768			!default exclude value.	JDIM(1)= BUF(1)			!#  SAMPLES	JDIM(2)= BUF(2)			!#  LINES	JDIM(3)= BUF(3)			!#  BANDS0	LUN =    BUF(6)			!logical unit for output file#	ISP =    BUF(7)			!spooled printer0	IF (CBUF(1:1).NE.' ')JFILE(1:IPT) = CBUF(1:IPT)$C initialize cube file control block,	CALL L2L (0,JFCB,-256)		! zero entire array(	JFCB(1) = LUN			! logical unit for file-	CALL L2L (JDIM,JFCB(32),3)	! cube dimensions;      WRITE (ISP,'(A,3I5)')' Output Cube dimensions =',JDIMC  Create cube labelE      CALL CRQLAB(JLABEL,3,JDIM,AXNAME,CORNAM,CORTYP,2,JEXCL,NOTE,IR),      WRITE (ISP,*) ' CRQLAB return code',IR&      IF (IR.LT.0) STOP 'CRQLAB error'*      CR=CHAR(13)				   	!  TEMP kludge to*      LF=CHAR(10)				   	!   insert  "END"?      IF (IR.GT.0) JLABEL(IR+1:IR+5)='END'//CR//LF	!   in label+      JFCB(LKP)=IR					!  TEMP end of label8CC      CALL DSPLAB(JLABEL,MAXLAB,ISP)			! display labelC  Open output cube file0      CALL OPCUBE(JFCB,JFILE,JSBSPC,2,JLABEL,IR),      WRITE (ISP,*) ' OPCUBE return code',IR.      IF (IR.NE.0) STOP 'OPCUBE outfile error'<      LJDATA=2*JDIM(1)*JDIM(2)			! set buffer length (bytes)	ELSEIF (KBAND.EQ.-2) THEN		CORNAM = CBUF	ELSEIF (KBAND.EQ.-3) THEN
		NOTE = CBUF	ELSE4		TYPE *,' CUBEOUT called with illegal KBAND=',KBAND	ENDIF	GOTO 9C83000	CALL PTIMAG(JFCB,KBAND,BUF,LJDATA,IR)		! write bandA	IF (IR.NE.0) THEN	! 0 ok, -1 band out of range, -3 buf too smallC	  WRITE (ISP,*) ' PTIMAG return code =',IR	! >0 vms i/o error code	ENDIF	GOTO 944000	CALL CLCUBE(JFCB,JLABEL,HISTRY,IR)	! close file'	WRITE (ISP,*) ' CLCUBE return code',IR	GOTO 99	RETURN	END