C Copyright(c) 1997, Space Science and Engineering Center, UW-Madison
C Refer to "McIDAS Software Acquisition and Distribution Policies"
C in the file  mcidas/data/license.txt

        FUNCTION DCOIMG(CTYPE)
C *** $Id: dcoimg.f,v 1.10 1997/10/10 20:16:51 dglo Exp $ ***
C     DCOIMG: UNPACKS AND STORES IMAGE FROM PAA
       IMPLICIT INTEGER*2(A-B,D-Z)
       IMPLICIT CHARACTER*12 (C)
       INTEGER*2 JBUF(8008)
       INTEGER*4 OAREA,NLIN,NELE,LRES,ERES,OLIN,OELE,ARADIR,PATTRN,IPAT
       INTEGER*4 NBYTE,DCOIMG,LINE4,RETBYT,INT4, GETSYN

       INTEGER*4 TWO, LEN16, IDSIZ2, IFLAG, NIBS, LEN4, BITS, LEN1,BITS3

       COMMON/HDRCOM/ OAREA,NLIN,NELE,LRES,ERES,OLIN,OELE,ARADIR(64)
       CHARACTER*1 CTYPE
       DIMENSION IBUF(1001),DELTA(13)
       DATA DELTA/-6,6,-5,5,-4,4,-3,3,-2,2,-1,1,0/
C       DATA IPAT/#00FF00FF/  NOTE : #00FF00FF = 16711935
C       DATA IPAT/16711935/
C
C--- START READING BLOCKS FROM INPUT FILE
C
	IPAT = GETSYN()
	CALL FBYTE4(IPAT,1)
        DCOIMG=-1
        IFLAG=0
        LEN1=1
        LEN3=3
        LEN4=4
        LEN16=16
        IDSIZ2=2
        IDSIZ4=4
        TWO=2
        LASLIN=OLIN-1
        IPOS=768
        JELE=OELE
        KLINE=-1
        OLIN2=OLIN
        OELE2=OELE
        IZBYTE=OELE2*2
C
C---
C
1       CONTINUE
C
C---    GET LINE # AND NUMBER OF DATA BYTES
C
        CALL GRAB(4,IBUF,RETBYT)
        CALL CRACKB(TWO,IBUF,0,LEN16,JBUF,IDSIZ2,IFLAG)
        LINE=JBUF(1)
        NBYTE=JBUF(2)
122     CONTINUE
        IF(LINE.LT.0.OR.LINE.GT.OLIN2) GOTO 1
        IF(NBYTE.GT.12520) GOTO 1
C
        CALL GRAB(NBYTE,IBUF,RETBYT)
C
C---  GET A LINE OF DATA (16 GRAY LEVEL --- RUN-LENGTH ENCODED)
C
        IF(CTYPE.EQ.'G') THEN
                NIBS=NBYTE*2
                CALL CRACKB(NIBS,IBUF,0,LEN4,JBUF,IDSIZ2,IFLAG)
                KOUNT=0
                DO 5 I=1,NIBS,2
                        IVAL=JBUF(I)
                        IVAL=IVAL*20+10
                        REPEAT=JBUF(I+1)
                        DO 2 K=0,REPEAT
                                KOUNT=KOUNT+1
                                IF (KOUNT.GT.1000) GOTO 100
                                IBUF(KOUNT)=IVAL
2                       CONTINUE
5               CONTINUE
                GOTO 100
        ENDIF
C
C---  GET A LINE OF DATA (HALF TONE --- STRAIGHT BINARY)
C
        IF(CTYPE.EQ.'H') THEN
                BITS=NBYTE*8
                CALL CRACKB(BITS,IBUF,0,LEN1,JBUF,IDSIZ2,IFLAG)
                JKOUNT=0
                DO 6 I=1,OELE2
                        KOUNT=KOUNT+1
                        IF (KOUNT.GT.1000) GOTO 100
                        IBUF(KOUNT)=JBUF(I)*255
6               CONTINUE
                GOTO 100
        ENDIF
C
C---  GET A LINE OF DATA (QUARTER TONE --- STRAIGHT BINARY)
C
        IF(CTYPE.EQ.'Q') THEN
                BITS=NBYTE*8
                BITS3=BITS/3
                CALL CRACKB(BITS3,IBUF,0,LEN3,JBUF,IDSIZ2,IFLAG)
                JKOUNT=0
                DO 7 I=1,OELE2
                        KOUNT=KOUNT+1
                        IF (KOUNT.GT.1000) GOTO 100
                        IBUF(KOUNT)=JBUF(I)*15+15
7               CONTINUE
                GOTO 100
        ENDIF
C
C---  GET A LINE OF DATA (SQEEZED HALF TONES --- 4-BIT DELTA)
C
        IF(CTYPE.EQ.'S') THEN
                NIBS=NBYTE*2
                CALL CRACKB(NIBS,IBUF,0,LEN4,JBUF,IDSIZ2,IFLAG)
                KOUNT=0
                LAST=0
                PTR=1
20              CONTINUE
                NEXT=JBUF(PTR)
                PTR=PTR+1
                IF(NEXT.EQ.0) THEN
                        KOUNT=KOUNT+1
                        IF (KOUNT.GT.1000) GOTO 100
                        IBUF(KOUNT)=JBUF(PTR)*16+JBUF(PTR+1)
                        LAST=IBUF(KOUNT)
                        PTR=PTR+2
                        GOTO 20
                ENDIF
                IF(NEXT.GE.1.AND.NEXT.LE.13) THEN
                        LAST=LAST+DELTA(NEXT)
                        KOUNT=KOUNT+1
                        IF (KOUNT.GT.1000) GOTO 100
                        IBUF(KOUNT)=LAST
                        GOTO 20
                ENDIF
                IF(NEXT.EQ.13.OR.NEXT.EQ.15) THEN
                        KOUNT=KOUNT+1
                        IF (KOUNT.GT.998) GOTO 100
                        IBUF(KOUNT)=LAST
                        KOUNT=KOUNT+1
                        IBUF(KOUNT)=LAST
                        IF(NEXT.EQ.15) THEN
                                KOUNT=KOUNT+1
                                IBUF(KOUNT)=LAST
                        ENDIF
                        GOTO 20
                ENDIF
        ENDIF
C
C---  OUTPUT TO FILE
C
100     CONTINUE
        CALL PACK2(INT4(OELE2),IBUF,IBUF)
        LINE4=LINE
        CALL WRTARA(OAREA,LINE4,IBUF)
C
C--- TEST FOR SYNC
C
10      CALL GRAB(4,PATTRN,RETBYT)
        IF(PATTRN.NE.IPAT) THEN
                LINE4=LINE
                CALL EDEST('Lost Sync Pattern at line=',LINE4)
                CALL RESYNC(ISTAT)
                IF(ISTAT.NE.0) THEN
                  CALL EDEST(' Failed to Re-Sync transmission',0)
                  RETURN
                ELSE
                  CALL EDEST(' Re-Sync successful',0)
                ENDIF
        ENDIF
        IF(LINE.NE.LASLIN) GOTO 1
        DCOIMG=0
        RETURN
        END
