* Last processed by NICE on 12-Jun-2000 15:54:00
* Customized for :  IEEE, LINUX, UNIX, MOTIF, F77
      PROGRAM HISVIEW_MAIN
C----------------------------------------------------------------------
C X-Window viewer for HIS(or HSV) combined images
C----------------------------------------------------------------------
      INCLUDE 'inc:xpar.inc'
      INCLUDE 'inc:ypar.inc'
      INCLUDE 'inc:zpar.inc'
      INCLUDE 'inc:format.inc'
      INCLUDE 'inc:errcod.inc'
      INCLUDE 'inc:memory.inc'
      INCLUDE 'hisview.inc'
*
      CHARACTER*80 NAMEH, NAMES, NAMEV
      CHARACTER*256 UIDDIR
      INTEGER*4 POINTER
      INTEGER*4 XBLC(2), XTRC(2), YBLC(2), YTRC(2), ZBLC(2), ZTRC(2)
      INTEGER I,FORM,N, LENC
      LOGICAL ERROR
*
      EXTERNAL USER_COORD
      DATA XBLC /2*0/, XTRC /2*0/
      DATA YBLC /2*0/, YTRC /2*0/
      DATA ZBLC /2*0/, ZTRC /2*0/
*
      CALL GILDAS_OPEN
      CALL GILDAS_CHAR('X_NAME$',NAMEH)
      CALL GILDAS_INTE('XBLC$',XBLC,2)
      CALL GILDAS_INTE('XTRC$',XTRC,2)
      CALL GILDAS_CHAR('Y_NAME$',NAMES)
      CALL GILDAS_INTE('YBLC$',YBLC,2)
      CALL GILDAS_INTE('YTRC$',YTRC,2)
      CALL GILDAS_CHAR('Z_NAME$',NAMEV)
      CALL GILDAS_INTE('ZBLC$',ZBLC,2)
      CALL GILDAS_INTE('ZTRC$',ZTRC,2)
      CALL GILDAS_CLOSE
      N = LENC(NAMEH)
      CALL SIC_PARSEF(NAMEH(1:N),X_FILE,' ','.gdf')
      CALL GDF_GEIS (X_ISLO,ERROR)
      IF (.NOT.ERROR) CALL
     $GDF_REIS (X_ISLO,X_TYPE,X_FILE,X_FORM,X_SIZE,ERROR)
      IF (ERROR) THEN
         WRITE(6,*) 'F-HISVIEW,  Cannot read input file for Hue'
         CALL SYSEXI(FATALE)
      ENDIF
      CALL GDF_READX (X_ISLO,ERROR)
      N = LENC(NAMES)
      CALL SIC_PARSEF(NAMES(1:N),Y_FILE,' ','.gdf')
      CALL GDF_GEIS (Y_ISLO,ERROR)
      IF (.NOT.ERROR) CALL
     $GDF_REIS (Y_ISLO,Y_TYPE,Y_FILE,Y_FORM,Y_SIZE,ERROR)
      IF (ERROR) THEN
         WRITE(6,*) 'F-HISVIEW,  Cannot read input file for Saturation'
         CALL SYSEXI(FATALE)
      ENDIF
      CALL GDF_READY (Y_ISLO,ERROR)
      N = LENC(NAMEV)
      CALL SIC_PARSEF(NAMEV(1:N),Z_FILE,' ','.gdf')
      CALL GDF_GEIS (Z_ISLO,ERROR)
      IF (.NOT.ERROR) CALL
     $GDF_REIS (Z_ISLO,Z_TYPE,Z_FILE,Z_FORM,Z_SIZE,ERROR)
      IF (ERROR) THEN
         WRITE(6,*) 'F-HISVIEW,  Cannot read input file for Brightness'
         CALL SYSEXI(FATALE)
      ENDIF
      CALL GDF_READZ (Z_ISLO,ERROR)
*
* Define projection and axis types.
      IF (X_PROJ.NE.0 .AND. X_PTYP.NE.0) THEN
         IF (X_XAXI.EQ.0.AND.X_YAXI.EQ.0) THEN
            X_XAXI = 1
            X_YAXI = 2
         ENDIF
         CALL GR8_PROJEC(X_PTYP,X_A0)
      ELSE
         X_XAXI = 1
         X_YAXI = 2
         CALL GR8_PROJEC(0,X_A0)
      ENDIF
      IF (X_FAXI.EQ.0) THEN
         DO I=1,3
            IF (I.NE.X_XAXI .AND. I.NE.X_YAXI) X_FAXI = I
         ENDDO
      ENDIF
      IF (Y_PROJ.NE.0 .AND. Y_PTYP.NE.0) THEN
         IF (Y_XAXI.EQ.0.AND.Y_YAXI.EQ.0) THEN
            Y_XAXI = 1
            Y_YAXI = 2
         ENDIF
         CALL GR8_PROJEC(Y_PTYP,Y_A0)
      ELSE
         Y_XAXI = 1
         Y_YAXI = 2
         CALL GR8_PROJEC(0,Y_A0)
      ENDIF
      IF (Y_FAXI.EQ.0) THEN
         DO I=1,3
            IF (I.NE.Y_XAXI .AND. I.NE.Y_YAXI) Y_FAXI = I
         ENDDO
      ENDIF
      IF (Z_PROJ.NE.0 .AND. Z_PTYP.NE.0) THEN
         IF (Z_XAXI.EQ.0.AND.Z_YAXI.EQ.0) THEN
            Z_XAXI = 1
            Z_YAXI = 2
         ENDIF
         CALL GR8_PROJEC(Z_PTYP,Z_A0)
      ELSE
         Z_XAXI = 1
         Z_YAXI = 2
         CALL GR8_PROJEC(0,Z_A0)
      ENDIF
      IF (Z_FAXI.EQ.0) THEN
         DO I=1,3
            IF (I.NE.Z_XAXI .AND. I.NE.Z_YAXI) Z_FAXI = I
         ENDDO
      ENDIF
*
* Blanking
      IF (X_BLAN.EQ.0) THEN
         X_BVAL = 0.0
         X_EVAL = -1.0
      ENDIF
*
* Define and load images subsets
      DO I=1,2
         XBLC(I) = MAX(1,MIN(XBLC(I),X_DIM(I)))
         YBLC(I) = MAX(1,MIN(YBLC(I),Y_DIM(I)))
         ZBLC(I) = MAX(1,MIN(ZBLC(I),Z_DIM(I)))
         IF (XTRC(I).EQ.0) THEN
            XTRC(I) = X_DIM(I)
         ELSE
            XTRC(I) = MIN(X_DIM(I),XTRC(I))
         ENDIF
         IF (YTRC(I).EQ.0) THEN
            YTRC(I) = Y_DIM(I)
         ELSE
            YTRC(I) = MIN(Y_DIM(I),YTRC(I))
         ENDIF
         IF (ZTRC(I).EQ.0) THEN
            ZTRC(I) = Z_DIM(I)
         ELSE
            ZTRC(I) = MIN(Z_DIM(I),ZTRC(I))
         ENDIF
         DIMH(I) = XTRC(I)-XBLC(I)+1
         IF((YTRC(I)-YBLC(I)+1).NE.DIMH(I)) GOTO 999
         IF((ZTRC(I)-ZBLC(I)+1).NE.DIMH(I)) GOTO 999
      ENDDO
      HX = XBLC(1)
      HY = XBLC(2)
      SX = YBLC(1)
      SY = YBLC(2)
      VX = ZBLC(1)
      VY = ZBLC(2)
*
      FORM = FMT_R4
      CALL GDF_GEMS (Y_MSLO,Y_ISLO,YBLC,YTRC,Y_ADDR,FORM,ERROR)
      IF (ERROR) WRITE(6, *) 'ERROR Y'
      CALL GDF_GEMS (Z_MSLO,Z_ISLO,ZBLC,ZTRC,Z_ADDR,FORM,ERROR)
      IF (ERROR) WRITE(6, *) 'ERROR Z'
      CALL GDF_GEMS (X_MSLO,X_ISLO,XBLC,XTRC,X_ADDR,FORM,ERROR)
      IF (ERROR) WRITE(6, *) 'ERROR X'
*
      IPX = POINTER(X_ADDR,MEMORY)
      IPY = POINTER(Y_ADDR,MEMORY)
      IPZ = POINTER(Z_ADDR,MEMORY)
*
* Give to HISVIEW
      N = LENC(X_FILE)+1
      X_FILE(N:N) = CHAR(0)
      N = LENC(Y_FILE)+1
      Y_FILE(N:N) = CHAR(0)
      N = LENC(Z_FILE)+1
      Z_FILE(N:N) = CHAR(0)
      UIDDIR = 'GILDAS_UID:'
      CALL SIC_GTLGTR(UIDDIR)
      IF (UIDDIR.EQ.'GILDAS_UID:') UIDDIR = ' '
      N = LENC(UIDDIR)+1
      UIDDIR(N:N) = CHAR(0)
      CALL HISVIEW (X_FILE,Y_FILE,Z_FILE,
     $MEMORY(IPX),MEMORY(IPY), MEMORY(IPZ),DIMH,UIDDIR,
     $USER_COORD)
999   CALL GAGOUT('S-HISVIEW,  Dimensions not compatible')
      CALL SYSEXI(FATALE)
      END
*<FF>
      SUBROUTINE USER_COORD(IM,IX,JY,CHAINX,CHAINY,CHAINV)
      CHARACTER*80 CHAINX,CHAINY,CHAINV
      INTEGER IM,IX,JY
      REAL *8 U(2)
*
      INCLUDE 'inc:xpar.inc'
      INCLUDE 'inc:ypar.inc'
      INCLUDE 'inc:zpar.inc'
      INCLUDE 'inc:memory.inc'
      INCLUDE 'hisview.inc'
      REAL*8 UPX,VPY,AUX,AVY
      REAL*4 R, VALUE
      INTEGER*4 POINTER
      INTEGER LENC
      CHARACTER*80 CHAIN(2)
*
      DATA CHAIN/' ',' '/
*
* Get value first
      IF (IM.EQ.1) THEN
         IPX = POINTER(X_ADDR,MEMORY)
         R = VALUE (MEMORY(IPX),DIMH(1),DIMH(2),IX,JY)
         WRITE(CHAINV,'(1PG11.3)') R
         CHAINV(13:) = X_UNIT
         IX = IX+HX-1
         JY = JY+HY-1
         U(1) = (DFLOAT(IX)-X_REF1)*X_INC1+X_VAL1
         U(2) = (DFLOAT(JY)-X_REF2)*X_INC2+X_VAL2
         UPX = U(X_XAXI)
         VPY = U(X_YAXI)
      ELSEIF (IM.EQ.2) THEN
         IPY = POINTER(Y_ADDR,MEMORY)
         R = VALUE (MEMORY(IPY),DIMH(1),DIMH(2),IX,JY)
         WRITE(CHAINV,'(1PG11.3)') R
         CHAINV(13:) = Y_UNIT
         IX = IX+SX-1
         JY = JY+SY-1
         U(1) = (DFLOAT(IX)-Y_REF1)*Y_INC1+Y_VAL1
         U(2) = (DFLOAT(JY)-Y_REF2)*Y_INC2+Y_VAL2
         UPX = U(Y_XAXI)
         VPY = U(Y_YAXI)
      ELSEIF (IM.EQ.3) THEN
         IPZ = POINTER(Z_ADDR,MEMORY)
         R = VALUE (MEMORY(IPZ),DIMH(1),DIMH(2),IX,JY)
         WRITE(CHAINV,'(1PG11.3)') R
         CHAINV(13:) = Z_UNIT
         IX = IX+VX-1
         JY = JY+VY-1
         U(1) = (DFLOAT(IX)-Z_REF1)*Z_INC1+Z_VAL1
         U(2) = (DFLOAT(JY)-Z_REF2)*Z_INC2+Z_VAL2
         UPX = U(Z_XAXI)
         VPY = U(Z_YAXI)
      ENDIF
*
      CALL REL_TO_ABS (UPX, VPY, AUX, AVY, 1)
*
      IF (IM.EQ.1) THEN
         CALL SEXAG(CHAIN(X_XAXI),AUX,24)
         CALL SEXAG(CHAIN(X_YAXI),AVY,360)
      ELSEIF (IM.EQ.2) THEN
         CALL SEXAG(CHAIN(Y_XAXI),AUX,24)
         CALL SEXAG(CHAIN(Y_YAXI),AVY,360)
      ELSEIF (IM.EQ.3) THEN
         CALL SEXAG(CHAIN(Z_XAXI),AUX,24)
         CALL SEXAG(CHAIN(Z_YAXI),AVY,360)
      ENDIF
*
* Inverse permutation
      CHAINX = CHAIN(1)(1:LENC(CHAIN(1)))//CHAR(0)
      CHAINY = CHAIN(2)(1:LENC(CHAIN(2)))//CHAR(0)
      END
*<FF>
      FUNCTION VALUE(Z,NX,NY,IX,IY)
      INTEGER NX,NY,IX,IY
      REAL VALUE,Z(NX,NY)
*
      VALUE = Z(IX,IY)
      END
*<FF>
