atrem_cubeio.f90

Go to the documentation of this file.

module cubeio
 
      INTEGER, PARAMETER :: INT16 = selected_int_kind(4)
 
contains
!***********************************************************************
!--- Subroutine to open an input imaging spectrometer data cube ---
      SUBROUTINE openinfile(LUN_IN, I_RET)
 
      INTEGER, intent(in)  :: LUN_IN
      INTEGER, intent(out) :: I_RET
      CHARACTER (LEN = 1000) :: FINAV
      COMMON /incube/  finav
 
      OPEN(lun_in,file=finav,access='stream',status='old',             &
     & form='unformatted',action='read', iostat=ios)
      i_ret = ios
 
      END SUBROUTINE openinfile
!---------------------------------------------------------------------
 
!--- Subroutine to open an output reflectance data cube ---
      SUBROUTINE openoutfile(LUN_OUT, I_RET)
 
      INTEGER, intent(in) :: LUN_OUT
      INTEGER, intent(out) :: I_RET
      CHARACTER (LEN = 1000) :: FOCUB
      COMMON /outcube/  focub
 
      OPEN(lun_out,file=focub,access='stream', status='unknown',        &
     & form='unformatted',action='write', iostat=ios)
      i_ret = ios
 
      END SUBROUTINE openoutfile
!---------------------------------------------------------------------
 
!--- Subroutine to open an output water vapor image file ---
      SUBROUTINE openvapfile(LUN_VAP, I_RET)
 
      INTEGER, intent(in) :: LUN_VAP
      INTEGER, intent(out) :: I_RET
      CHARACTER (LEN = 1000) :: FOH2O
      COMMON /outh2ovap/ foh2o
 
      OPEN(lun_vap,file=foh2o,access='stream',status='unknown',         &   
     & form='unformatted',action='write', iostat=ios)
      i_ret = ios
 
      END SUBROUTINE openvapfile
!---------------------------------------------------------------------
 
 
!***********************************************************************
!--- Subroutine to read a slice of spatial & spectral data ----
      SUBROUTINE rd_slice(LUN_IN,NSAMPS,NBANDS,SORDER,BUFFER)
      
      INTEGER, intent(in) :: LUN_IN,NSAMPS,NBANDS,SORDER
      INTEGER(INT16), DIMENSION(NBANDS*NSAMPS), intent(out) :: BUFFER
 
      INTEGER(INT16), DIMENSION(NSAMPS,NBANDS) :: BUFFER_BIL
      INTEGER(INT16), DIMENSION(NBANDS,NSAMPS) :: BUFFER_BIP
 
      READ(lun_in) buffer
 
      IF(sorder == 2) then
        buffer_bil = reshape(buffer, (/ nsamps, nbands /) )
        buffer_bip = transpose(buffer_bil)
        buffer     = reshape(buffer_bip, (/nbands*nsamps/))
      END IF
 
      END SUBROUTINE rd_slice
!---------------------------------------------------------------------
 
 
!--- Subroutine to write a slice of spatial & spectral data ----
      SUBROUTINE wt_slice(LUN_OUT,NSAMPS,NBANDS,SORDER,BUFFER)
    
      INTEGER, intent(in) :: LUN_OUT,NSAMPS,NBANDS,SORDER
 
      INTEGER(INT16), DIMENSION(NBANDS*NSAMPS), intent(inout) :: BUFFER
 
      INTEGER(INT16), DIMENSION(NBANDS,NSAMPS) :: BUFFER_BIP
      INTEGER(INT16), DIMENSION(NSAMPS,NBANDS) :: BUFFER_BIL
 
      IF(sorder == 1) WRITE(lun_out) buffer
 
      IF(sorder == 2) then
        buffer_bip = reshape(buffer, (/nbands,nsamps/))
        buffer_bil = transpose(buffer_bip)
        buffer     = reshape(buffer_bil, (/nbands*nsamps/))
        WRITE(lun_out) buffer
      END IF
 
      END SUBROUTINE wt_slice
!---------------------------------------------------------------------
 
 
!--- Subroutine to write a 'line' of water vapor data ----
      SUBROUTINE wt_line(LUN_VAP,NSAMPS,H2OBUF)
 
      INTEGER, intent(in) :: LUN_VAP,NSAMPS
 
      INTEGER(INT16), DIMENSION(NSAMPS), intent(inout) :: H2OBUF
 
      WRITE(lun_vap) h2obuf
 
      END SUBROUTINE wt_line
 
!***********************************************************************
 
 
!--- Subroutine to close the input imaging spectrometer data cube ---
      SUBROUTINE closeinfile(LUN_IN)
         INTEGER :: LUN_IN
         CLOSE(lun_in, status='keep')
      END SUBROUTINE closeinfile
!---------------------------------------------------------------------
 
 
!--- Subroutine to close the output reflectance data cube ---
      SUBROUTINE closeoutfile(LUN_OUT)
         INTEGER :: LUN_OUT
         CLOSE(lun_out, status='keep')
      END SUBROUTINE closeoutfile
 
 
!--- Subroutine to close the output water vapor image file ---
      SUBROUTINE closevapfile(LUN_VAP)
         INTEGER :: LUN_VAP
         CLOSE(lun_vap, status='keep')
      END SUBROUTINE closevapfile
 
!***********************************************************************
end module cubeio