/ 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