* Last processed by NICE on 12-Jun-2000 15:51:00
* Customized for :  IEEE, LINUX, UNIX, MOTIF, F77
      PROGRAM HEADER_MAIN
      INCLUDE 'inc:xpar.inc'
      INCLUDE 'inc:format.inc'
      INCLUDE 'inc:errcod.inc'
      CHARACTER*80 FILE
      INTEGER N,LENC
      LOGICAL ERROR,MODIFY
*
      CALL GILDAS_OPEN
      CALL GILDAS_CHAR('FILE$',FILE)
      CALL GILDAS_CLOSE
      N = LENC(FILE)
      IF (N.EQ.0) STOP
*
      CALL SIC_PARSEF(FILE,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) GOTO 99
      CALL GDF_READX (X_ISLO,ERROR)
*
      CALL MAKE_SCREEN
      CALL SHOW_SCREEN (MODIFY)
*
* Save new header
      IF (.NOT.MODIFY) STOP 'S-HEADER,  Header not modified'
      CALL GDF_WRITX(X_ISLO,ERROR)
      CALL GDF_CLIS (X_ISLO,ERROR)
      CALL GDF_UPIH (X_ISLO,X_FILE,ERROR)
      IF (.NOT.ERROR) THEN
         CALL GDF_FRIS (X_ISLO,ERROR)
         STOP 'S-HEADER,  Header successfully updated'
      ENDIF
99    CALL SYSEXI(FATALE)
      END
*<FF>
      SUBROUTINE GR4_EXTREMA (NXY,Z,BVAL,EVAL,ZMIN,ZMAX,NMIN,NMAX)
      INTEGER NXY,I,J,NMIN,NMAX
      REAL*4 ZMIN,ZMAX,Z(NXY),BVAL,EVAL
*
      IF (EVAL.LT.0.0) THEN
         ZMIN = Z(1)
         ZMAX = Z(1)
         NMIN = 1
         NMAX = 1
         DO I=2,NXY
            IF (Z(I).LT.ZMIN) THEN
               ZMIN = Z(I)
               NMIN = I
            ELSEIF (Z(I).GT.ZMAX) THEN
               ZMAX = Z(I)
               NMAX = I
            ENDIF
         ENDDO
      ELSE
         DO J=1,NXY
            IF (ABS(Z(J)-BVAL).GT.EVAL) THEN
               ZMIN = Z(J)
               ZMAX = Z(J)
               NMIN = J
               NMAX = J
               GOTO 10
            ENDIF
         ENDDO
10       CONTINUE
         DO I=J,NXY
            IF (ABS(Z(I)-BVAL).GT.EVAL) THEN
               IF (Z(I).LT.ZMIN) THEN
                  ZMIN = Z(I)
                  NMIN = I
               ELSEIF (Z(I).GT.ZMAX) THEN
                  ZMAX = Z(I)
                  NMAX = I
               ENDIF
            ENDIF
         ENDDO
      ENDIF
      END
*<FF>
      SUBROUTINE GR8_EXTREMA (NXY,Z,BVAL,EVAL,ZMIN,ZMAX,NMIN,NMAX)
      INTEGER NXY,I,J,NMIN,NMAX
      REAL*8 ZMIN,ZMAX,Z(NXY)
      REAL*4 BVAL,EVAL
*
      IF (EVAL.LT.0.0) THEN
         ZMIN = Z(1)
         ZMAX = Z(1)
         NMIN = 1
         NMAX = 1
         DO I=2,NXY
            IF (Z(I).LT.ZMIN) THEN
               ZMIN = Z(I)
               NMIN = I
            ELSEIF (Z(I).GT.ZMAX) THEN
               ZMAX = Z(I)
               NMAX = I
            ENDIF
         ENDDO
      ELSE
         DO J=1,NXY
            IF (ABS(Z(J)-BVAL).GT.EVAL) THEN
               ZMIN = Z(J)
               ZMAX = Z(J)
               NMIN = J
               NMAX = J
               GOTO 10
            ENDIF
         ENDDO
10       CONTINUE
         DO I=J,NXY
            IF (ABS(Z(I)-BVAL).GT.EVAL) THEN
               IF (Z(I).LT.ZMIN) THEN
                  ZMIN = Z(I)
                  NMIN = I
               ELSEIF (Z(I).GT.ZMAX) THEN
                  ZMAX = Z(I)
                  NMAX = I
               ENDIF
            ENDIF
         ENDDO
      ENDIF
      END
*<FF>
      SUBROUTINE SAVE_CURRENT_HEADER
      INCLUDE 'inc:xpar.inc'
      CHARACTER*120 SFILE
      CHARACTER*12  STEXT(MXCPAR)
      INTEGER SIPAR(MXIPAR)
      INTEGER SPAR (MXPAR)
*
      SAVE SFILE,STEXT,SIPAR,SPAR
*
      SFILE = X_FILE
      STEXT(1) = X_TYPE                  ! Image type
      STEXT(2) = X_UNIT                  ! Image unit
      STEXT(3) = X_CODE(1)               !	Axis type
      STEXT(4) = X_CODE(2)               !	Axis type
      STEXT(5) = X_CODE(3)               !	Axis type
      STEXT(6) = X_CODE(4)               !	Axis type
      STEXT(7) = X_SYST                  ! System type
      STEXT(8) = X_NAME                  ! Source name
      STEXT(9) = X_LINE                  ! Line name
*
      CALL R4TOR4 (X_SIZE,SIPAR,MXIPAR)
      CALL R4TOR4 (X_ITYP,SPAR,MXPAR)
      RETURN
*
      ENTRY RESTORE_CURRENT_HEADER
      CALL R4TOR4 (SIPAR,X_SIZE,MXIPAR)
      CALL R4TOR4 (SPAR,X_ITYP,MXPAR)
      X_FILE = SFILE
      X_TYPE  = STEXT(1)                 ! Image type
      X_UNIT = STEXT(2)                  ! Image unit
      X_CODE(1) = STEXT(3)               !	Axis type
      X_CODE(2) = STEXT(4)               !	Axis type
      X_CODE(3) = STEXT(5)               !	Axis type
      X_CODE(4) = STEXT(6)               !	Axis type
      X_SYST = STEXT(7)                  ! System type
      X_NAME = STEXT(8)                  ! Source name
      X_LINE = STEXT(9)                  ! Line name
      END
*<FF>
      SUBROUTINE MAKE_SCREEN
C----------------------------------------------------------------------
C GILDAS
C	Support routine for command HEADER, and program HEADER
C----------------------------------------------------------------------
      INCLUDE 'inc:xpar.inc'
      INCLUDE 'inc:format.inc'
      INTEGER MPROJ
      PARAMETER (MPROJ=8)
      CHARACTER*13 PROJNAM(MPROJ)
      INTEGER MFORM
      PARAMETER (MFORM = 6)
      CHARACTER*12 FORMAT(MFORM)
      CHARACTER CHRA*20,CHDE*20
      INTEGER I,J,LENC
* PI is defined with more digits than necessary to avoid losing
* the last few bits in the decimal to binary conversion
      REAL*8 PI
      PARAMETER (PI=3.14159265358979323846D0)
      INCLUDE 'screen.inc'
*
      EXTERNAL BLOCK_SCREEN
*
      DATA PROJNAM/'NONE','GNOMONIC','ORTHOGRAPHIC','AZIMUTHAL',
     $'STEREOGRAPHIC','LAMBERT','AITOFF','RADIO'/
      DATA FORMAT/'REAL*4','REAL*8','INTEGER*4','LOGICAL','INTEGER*2'
     $,'BYTE'/
*
      DO I=1,MWORD
         DO J=COL1(I),COL2(I)
            WORD(LINE(I),J) = I
         ENDDO
         LENG(I) = COL2(I)-COL1(I)+1
      ENDDO
C+VMS
c      I = 0
c      CALL LIB$FIND_FILE(X_FILE,X_FILE,I)
c      CALL LIB$FIND_FILE_END(I)
C-VMS
*
* General
      WRITE (CLINE(1),101) X_FILE(1:LENC(X_FILE)),
     $FORMAT (HARDWARE-X_FORM)
101   FORMAT ('File : ',T16,A,T66,A)
      CLINE(2) = 'Size        Reference Pixel           Value        '
     $//'          Increment'
      WRITE (CLINE(3),100) X_DIM(1),X_REF1,X_VAL1,X_INC1
100   FORMAT(I6,1X,1PG23.16,1X,1PG23.16,1X,1PG23.16)
      WRITE (CLINE(4),100) X_DIM(2),X_REF2,X_VAL2,X_INC2
      WRITE (CLINE(5),100) X_DIM(3),X_REF3,X_VAL3,X_INC3
      WRITE (CLINE(6),100) X_DIM(4),X_REF4,X_VAL4,X_INC4
*
* Blanking
      IF (X_BLAN.NE.0) THEN
         WRITE(CLINE(7),200) X_BVAL,X_EVAL
      ELSE
         WRITE(CLINE(7),200) 0.E0,-1.E0
      ENDIF
200   FORMAT('Blanking value and tolerance',5X,1PG15.8,1X,1PG15.8)
*
* Description
      IF (X_DESC.NE.0) THEN
         CLINE(10) = 'Map unit'
         CLINE(10)(21:) = X_UNIT
         CLINE(11) = 'Axis type'
         DO I=1,4                        ! gd...
            IF (LENC(X_CODE(I)).EQ.0) X_CODE(I)='UNKNOWN     '
         ENDDO
         CLINE(11)(21:) = X_CODE(1)//' '//X_CODE(2)//' '//X_CODE(3)
     $   //' '//X_CODE(4)
         CLINE(12) = 'Coordinate system'
         CLINE(12)(21:) = X_SYST
      ELSE
         CLINE(10) = 'Map unit'
         CLINE(10)(21:) = 'UNKNOWN      '
         CLINE(11) = 'Axis type'
         CLINE(11)(21:) = 'UNKNOWN      UNKNOWN      UNKNOWN      '
     $   //'UNKNOWN      '
         CLINE(12) = 'Coordinate system'
         CLINE(12)(21:) = 'UNKNOWN      '
      ENDIF
*
* Position
      CLINE(9)= 'Source name'
      CLINE(13)= 'Right Ascension                         Declination'
      CLINE(14)= 'Lii                                     Bii'
      CLINE(15)= 'Epoch'
      IF (X_POSI.NE.0) THEN
         CLINE(9)(21:32) = X_NAME
         CALL SEXAG(CHRA,X_RA,24)
         CALL SEXAG(CHDE,X_DEC,360)
         CLINE(13)(20:32) = CHRA
         CLINE(13)(59:71) = CHDE
         WRITE(CLINE(14)(10:32),'(1PG23.16)') X_LII*180.D0/PI
         WRITE(CLINE(14)(49:71),'(1PG23.16)') X_BII*180.D0/PI
         WRITE(CLINE(15)(18:32),'(1PG15.8)') X_EPOC
      ENDIF
*
* Projection
      CLINE(16) = 'Projection type                         Angle'
      CLINE(17) = 'Axis       A0'//
     $'                           Axis       D0'
      IF (X_PROJ.NE.0) THEN
C Modif GD sinc PROJ NONE is actually a projection... and task\convert
C uses explicitly X_A0 and X_D0 as 'centers of projections' of a NONE
C projection
C         IF (X_PTYP.EQ.0) THEN
C            CLINE(16)(21:32) = PROJNAM(1)
C         ELSEIF (X_SYST.EQ.'EQUATORIAL') THEN
         IF (X_SYST.EQ.'EQUATORIAL') THEN
            CLINE(16)(21:32) = PROJNAM(X_PTYP+1)
            WRITE(CLINE(16)(49:71),'(1PG23.16)') X_PANG*180D0/PI
            CALL SEXAG(CHRA,X_A0,24)
            CALL SEXAG(CHDE,X_D0,360)
            WRITE(CLINE(17)(6:6),'(I1)') X_XAXI
            WRITE(CLINE(17)(46:46),'(I1)') X_YAXI
            CLINE(17)(20:32) = CHRA
            CLINE(17)(59:71) = CHDE
         ELSEIF (X_SYST.EQ.'GALACTIC') THEN
            CLINE(16)(21:32) = PROJNAM(X_PTYP+1)
            WRITE(CLINE(16)(49:71),'(1PG23.16)') X_PANG*180D0/PI
            WRITE (CHRA,'(1PG13.7)')  X_A0 * 180.0D0 /PI
            WRITE (CHDE,'(1PG13.7)')  X_D0 * 180.0D0 /PI
            WRITE(CLINE(17)(6:6),'(I1)') X_XAXI
            WRITE(CLINE(17)(46:46),'(I1)') X_YAXI
            CLINE(17)(20:32) = CHRA
            CLINE(17)(59:71) = CHDE
         ENDIF
      ELSE
         CLINE(16)(21:32) = 'NOT DEFINED '
      ENDIF
*
* Extrema
      CLINE(18) = 'Minimum'
      CLINE(19) = 'Maximum'
      IF (X_EXTR.NE.0) THEN
         WRITE(CLINE(18)(18:),300) X_RMIN,X_MIN1,X_MIN2,X_MIN3,X_MIN4
         WRITE(CLINE(19)(18:),300) X_RMAX,X_MAX1,X_MAX2,X_MAX3,X_MAX4
      ENDIF
*
* Spectroscopy
      CLINE(20) = 'Axis   Line Name                        '//
     $'Rest Frequency'
      CLINE(21) = 'Resolution in Velocity                  '//
     $'in Frequency'
      CLINE(22) = 'Offset in Velocity                      '//
     $'Image Frequency'
      IF (X_SPEC.NE.0) THEN
         WRITE(CLINE(20)(6:6),'(I1)') X_FAXI
         CLINE(20)(21:32) = X_LINE
         WRITE(CLINE(20)(56:),'(1PG23.16)') X_FREQ
         WRITE(CLINE(21)(25:39),'(1PG15.8)') X_VRES
         WRITE(CLINE(21)(56:),'(1PG23.16)') X_FRES
         WRITE(CLINE(22)(25:39),'(1PG15.8)') X_VOFF
         WRITE(CLINE(22)(56:),'(1PG23.16)') X_FIMA
      ENDIF
*
300   FORMAT(1PG15.8,'  at ',I5,1X,I5,1X,I5,1X,I5)
      END
*<FF>
      SUBROUTINE FLINE (ISENS)
      INTEGER ISENS
      INCLUDE 'screen.inc'
*
      IF (ISENS.EQ.1) THEN
         IF (ILINE.LT.MLINE) THEN
            ILINE = ILINE+ISENS
            ICOL  = 1
            IWORD = WORD(ILINE,ICOL)
         ELSE
            CALL GAGOUT ('End of Page...')
         ENDIF
      ELSE
         IF (ILINE.GT.1) THEN
            ILINE = ILINE+ISENS
            ICOL  = 1
            IWORD = WORD(ILINE,ICOL)
         ELSE
            CALL GAGOUT ('Top of Page...')
         ENDIF
      ENDIF
      END
*<FF>
      SUBROUTINE NEW_HEADER(ERROR)
      LOGICAL ERROR
      INCLUDE 'inc:xpar.inc'
      INCLUDE 'screen.inc'
      INCLUDE 'inc:pi.inc'
      INTEGER MPROJ
      PARAMETER (MPROJ=8)
      CHARACTER*13 PROJNAM(MPROJ),KEY
      INTEGER NKEY,I,LENC
*
      DATA PROJNAM/'NONE','GNOMONIC','ORTHOGRAPHIC','AZIMUTHAL',
     $'STEREOGRAPHIC','LAMBERT','AITOFF','RADIO'/
*
* Xref Xval Xinc
      X_GENE = 29
      READ (CLINE(3)(8:),*,ERR=10) X_REF1,X_VAL1,X_INC1
      READ (CLINE(4)(8:),*,ERR=10) X_REF2,X_VAL2,X_INC2
      READ (CLINE(5)(8:),*,ERR=10) X_REF3,X_VAL3,X_INC3
      READ (CLINE(6)(8:),*,ERR=10) X_REF4,X_VAL4,X_INC4
*
* Blanking
      X_BLAN = 2
      READ (CLINE(7)(34:),*,ERR=20) X_BVAL,X_EVAL
*
      DO I=15,21
         CALL SIC_UPPER(CWORD(I))
      ENDDO
      X_NAME = CWORD(15)
      X_UNIT = CWORD(16)
      X_CODE(1) = CWORD(17)
      X_CODE(2) = CWORD(18)
      X_CODE(3) = CWORD(19)
      X_CODE(4) = CWORD(20)
*
      X_DESC = 18
      IF (CWORD(21).EQ.'UNKNOWN'.OR.CWORD(21).EQ.'GALACTIC'.
     $OR.CWORD(21).EQ.'EQUATORIAL')THEN
         X_SYST = CWORD(21)
      ELSE
         X_SYST = 'UNKNOWN'
      ENDIF
*
      X_POSI = 12
      IF (X_SYST.EQ.'EQUATORIAL') THEN
         CALL SIC_DECODE(CWORD(22),X_RA,24,ERROR)
         IF (ERROR) GOTO 30
         CALL SIC_DECODE(CWORD(23),X_DEC,360,ERROR)
         IF (ERROR) GOTO 30
         READ (CWORD(26),*,ERR=70) X_EPOC
         CALL EQU_GAL(X_RA,X_DEC,X_EPOC,X_LII,X_BII,1)
      ELSEIF (X_SYST.EQ.'GALACTIC') THEN
         READ (CWORD(24),*,ERR=40) X_LII
         READ (CWORD(25),*,ERR=40) X_BII
         X_LII = X_LII*PI/180.D0
         X_BII = X_BII*PI/180.D0
         X_EPOC = 1950.0
         CALL GAL_EQU(X_LII,X_BII,X_RA,X_DEC,X_EPOC,1)
      ENDIF
*
      X_PROJ=9
      CALL SIC_UPPER(CWORD(27))
      CALL SIC_AMBIGS('PROJECTION',CWORD(27),KEY,NKEY,PROJNAM,
     $MPROJ,ERROR)
      IF (ERROR) GOTO 50
      X_PTYP = NKEY-1
      IF (X_PTYP.NE.0) THEN
         READ (CWORD(28),*,ERR=50) X_PANG
         X_PANG = X_PANG*PI/180.0
         IF (X_SYST.EQ.'EQUATORIAL') THEN
            CALL SIC_DECODE(CWORD(30),X_A0,24,ERROR)
            IF (ERROR) GOTO 51
            CALL SIC_DECODE(CWORD(32),X_D0,360,ERROR)
            IF (ERROR) GOTO 51
         ELSE
            READ (CWORD(30),*,ERR=51) X_A0
            IF (X_A0.GT.360.0D0.OR.X_A0.LT.0.0D0) THEN
               CALL GAGOUT
     $         ('W-HEADER, A0 Must be in the (0,360) Range')
               ERROR = .TRUE.
               RETURN
            ENDIF
            X_A0 = X_A0 * PI /180.0D0
            READ (CWORD(32),*,ERR=51) X_D0
            IF (X_D0.GT.90.0D0.OR.X_D0.LT.-90.0D0) THEN
               CALL GAGOUT
     $         ('W-HEADER, D0 Must be in the (-90,+90) Range')
               ERROR = .TRUE.
               RETURN
            ENDIF
            X_D0 = X_D0 * PI /180.0D0
         ENDIF
         READ (CWORD(29)(1:1),501,ERR=60) X_XAXI
         READ (CWORD(31)(1:1),501,ERR=60) X_YAXI
         IF (X_XAXI.GT.4 .OR. X_XAXI.LT.0 .OR. X_YAXI.GT.4 .OR.
     $   X_YAXI.LT.0) GOTO 60
      ENDIF
*
* Spectroscopy
      IF (LENC(CWORD(44)).GT.0) THEN
         READ (CWORD(44),*,ERR=80) X_FREQ
         READ (CWORD(48),*,ERR=80) X_FIMA
         READ (CWORD(47),*,ERR=80) X_VOFF
         READ (CWORD(46),*,ERR=80) X_FRES
         READ (CWORD(49)(1:1),'(I1)',ERR=80) X_FAXI
         X_SPEC = 12
         X_LINE = CWORD(43)
         X_VRES = -X_FRES/X_FREQ*2.99792485D5
      ELSE
         X_SPEC = 0
      ENDIF
      ERROR = .FALSE.
      RETURN
*
501   FORMAT(I1)
*
10    CALL GAGOUT('W-HEADER,  Invalid axis conversion formula')
      ERROR = .TRUE.
      RETURN
20    CALL GAGOUT('W-HEADER,  Invalid blanking value')
      ERROR = .TRUE.
      RETURN
30    CALL GAGOUT('W-HEADER,  Invalid RA or DEC')
      ERROR = .TRUE.
      RETURN
40    CALL GAGOUT('W-HEADER,  Invalid LII or Bii')
      ERROR = .TRUE.
      RETURN
50    CALL GAGOUT('W-HEADER,  Invalid projection formula')
      ERROR = .TRUE.
      RETURN
51    CALL GAGOUT('W-HEADER,  Invalid Center Of Projection')
      ERROR = .TRUE.
      RETURN
60    CALL GAGOUT('W-HEADER,  Invalid projected axis')
      ERROR = .TRUE.
      RETURN
70    CALL GAGOUT('W-HEADER,  Invalid epoch')
      ERROR = .TRUE.
      RETURN
80    CALL GAGOUT('W-HEADER,  Invalid spectroscopy section')
      ERROR = .TRUE.
      RETURN
      END
*<FF>
      SUBROUTINE EXTREM (ERROR)
      LOGICAL ERROR
      INCLUDE 'inc:xpar.inc'
      INCLUDE 'inc:format.inc'
      INCLUDE 'inc:memory.inc'
      INCLUDE 'screen.inc'
      INTEGER IMIN,IMAX,MSLO
      INTEGER*4 IP, ADDR, POINTER
      INTEGER*4 BLC(4), TRC(4)
      DATA BLC/4*0/, TRC/4*0/
*
* Map the image Readonly if needed
      IF (X_FORM.NE.FMT_R4 .AND. X_FORM.NE.FMT_R8) THEN
         WRITE (6,*) 'E-EXTREMA,  Invalid format'
         ERROR = .TRUE.
         RETURN
      ENDIF
*
      CALL GDF_GEMS (MSLO, X_ISLO, BLC, TRC, ADDR, X_FORM, ERROR)
      IF (ERROR) RETURN
      IP = POINTER(ADDR,MEMORY)
      IF (X_FORM.EQ.FMT_R4) THEN
         CALL GR4_EXTREMA (X_SIZE,MEMORY(IP),X_BVAL,X_EVAL,
     $   X_RMIN,X_RMAX,IMIN,IMAX)
      ELSEIF (X_FORM.EQ.FMT_R8) THEN
         CALL GR8_EXTREMA (X_SIZE,MEMORY(IP),X_BVAL,X_EVAL,
     $   X_RMIN,X_RMAX,IMIN,IMAX)
      ENDIF
      CALL GDF_FRMS(MSLO,ERROR)
      IF (ERROR) RETURN
*
      IMIN = IMIN-1
      X_MIN4 = IMIN / (X_DIM(1)*X_DIM(2)*X_DIM(3))
      IMIN = IMIN - X_MIN4 * (X_DIM(1)*X_DIM(2)*X_DIM(3))
      X_MIN4 = X_MIN4 + 1
      X_MIN3 = IMIN / (X_DIM(1)*X_DIM(2))
      IMIN = IMIN - X_MIN3 * (X_DIM(1)*X_DIM(2))
      X_MIN3 = X_MIN3 + 1
      X_MIN2 = IMIN / X_DIM(1)
      X_MIN1 = IMIN - X_MIN2 * X_DIM(1) + 1
      X_MIN2 = X_MIN2 + 1
*
      IMAX = IMAX-1
      X_MAX4 = IMAX / (X_DIM(1)*X_DIM(2)*X_DIM(3))
      IMAX = IMAX - X_MAX4 * (X_DIM(1)*X_DIM(2)*X_DIM(3))
      X_MAX4 = X_MAX4 + 1
      X_MAX3 = IMAX / (X_DIM(1)*X_DIM(2))
      IMAX = IMAX - X_MAX3 * (X_DIM(1)*X_DIM(2))
      X_MAX3 = X_MAX3 + 1
      X_MAX2 = IMAX / X_DIM(1)
      X_MAX1 = IMAX - X_MAX2 * X_DIM(1) + 1
      X_MAX2 = X_MAX2 + 1
*
      X_EXTR = 10
      WRITE(CLINE(18)(18:),300)
     $X_RMIN,X_MIN1,X_MIN2,X_MIN3,X_MIN4
      WRITE(CLINE(19)(18:),300)
     $X_RMAX,X_MAX1,X_MAX2,X_MAX3,X_MAX4
300   FORMAT(1PG15.8,'  at ',I5,1X,I5,1X,I5,1X,I5)
      END
*<FF>
      BLOCKDATA BLOCK_SCREEN
      INCLUDE 'screen.inc'
      DATA LINE/3,3,3, 4,4,4, 5,5,5, 6,6,6,
     $7,7, 9, 10, 11,11,11,11, 12, 13,13,
     $14,14, 15, 16,16, 17,17,17,17,
     $18,18,18,18,18,19,19,19,19,19,
     $20,20, 21,21, 22,22, 20/
      DATA COL1/8,32,56, 8,32,56, 8,32,56, 8,32,56,
     $34,50, 21, 21, 21,34,47,60, 21, 20,59,
     $10,49, 18, 21,49, 6,20,46,59,
     $18,38,44,50,56, 18,38,44,50,56,
     $21,56, 25,56, 25,56, 6/
      DATA COL2/30,54,78, 30,54,78, 30,54,78, 30,54,78,
     $48,64, 32, 32, 32,45,58,71, 32, 32,71,
     $32,71, 32, 32,71, 6,32,46,71,
     $32,42,48,54,60, 32,42,48,54,60,
     $32,78, 39,78, 39,78, 6/
      END
*<FF>
      SUBROUTINE SHOW_SCREEN (MODIF)
      LOGICAL MODIF
      INCLUDE 'screen.inc'
      INTEGER I
*
      MODIF = .FALSE.
      DO I=1,MLINE
         CALL GAGOUT(CLINE(I))
      ENDDO
      END
