* Last processed by NICE on 12-Jun-2000 15:53:00
* Customized for :  IEEE, LINUX, UNIX, MOTIF, F77
c     $Header: /scisoft/gildas/sou/nic/main/nic_file.for,v 1.39 2000/01/28 09:11:37 broguier Exp $
c     $Log: nic_file.for,v $
c     Revision 1.39  2000/01/28 09:11:37  broguier
c     accept fits extension
c
C Revision 1.38  99/03/12  19:45:55  19:45:55  broguier (Dominique Broguiere)
C SIC_CH replaced by SIC_KE
C
C Revision 1.31  97/12/18  15:31:05  15:31:05  broguier ()
C add TOTPOW variables
C
C Revision 1.21  96/09/27  13:03:39  13:03:39  neri (Roberto Neri)
C error if scan number is in logical assignment
C i.e. /DON4/4.nmb = scan number is 4 and 4 is also DON number
C conversion yielded/DON0004.nmb instead of /DON4/0004.nmb
C
C Revision 1.20  96/09/03  18:25:51  18:25:51  broguier (Dominique Broguiere)
C correction for ascii files
C
C Revision 1.16  96/04/04  15:46:06  15:46:06  gildas (Gildas manager)
C new way to insure correct filenames and extensions. portability assured? GD.
C
C Revision 1.15  1996/03/29  11:22:56  broguier
C remove routine get_file_type and fixed_length_scan
C
*
      SUBROUTINE FILE(LINE,ERROR)
C ----------------------------------------------------------------------
C 	Support routine for command
C	FILE 	I[N] 	File_name
C		O[UT]	File_name
C Arguments :
C	LINE	C*(*)	Command line			Input
C	ERROR	L	Logical error flag		Output
C (5-mar-1985)
C ----------------------------------------------------------------------
      CHARACTER*(*) LINE
      LOGICAL ERROR
*
      INCLUDE 'nic.inc'
*
      LOGICAL SIC_PRESENT, DATA_TYPE
      CHARACTER CH*1,CHAIN*80,FICH*80, FTYPE*32
      INTEGER NFILE,LENC,FLEN,NC
      INTEGER I_SCAN,I_POINT,NUMBER
*
      CALL SIC_KE (LINE,0,1,CH,NC,.TRUE.,ERROR)
      IF (ERROR) GOTO 99
      IF (CH(1:1).NE.'I'.AND.CH(1:1).NE.'O'.AND.CH(1:1).NE.'B') THEN
         CALL MESSAGE(6,3,'FILE','IN or OUT please')
         ERROR = .TRUE.
         RETURN
      ENDIF
      IF (.NOT.SIC_PRESENT(0,2)) THEN
         CALL MESSAGE(6,3,'FILE','No default is provided '//
     $   'for the file name')
         ERROR = .TRUE.
         RETURN
      ENDIF
*
      CALL SIC_CH (LINE,0,2,CHAIN,NC,.TRUE.,ERROR)
      IF (ERROR) GOTO 99
      CALL SIC_PARSEF(CHAIN,FICH,' ',DEFEXT)
* Check extension
      I_SCAN = INDEX(FICH,CHAIN(1:LENC(CHAIN))//'.')
      I_POINT = INDEX(FICH(I_SCAN:),'.')
      FTYPE = FICH(I_SCAN+I_POINT-1:)
      FLEN = LENC(FTYPE)
      CALL CHECK_EXTENSION (FTYPE,FLEN, ERROR)
      IF (ERROR) RETURN
*Insures filename is i4.4 format
      READ (CHAIN,'(i4)',ERR=99) NUMBER
      WRITE (CHAIN,'(i4.4)',ERR=99) NUMBER
*Rebuilds a correct filename
      IF (I_SCAN.GT.1)THEN
         FICH=FICH(1:I_SCAN-1)//CHAIN(1:4)
      ELSE
         FICH=CHAIN(1:4)
      ENDIF
c      WRITE(*,*) FICH
*Insures correct case for filename and add extension
      FICH(LENC(FICH)+1:) = FTYPE(1:)
      CHAIN = FICH(1:LENC(FICH))//CHAR(0)
      NFILE = LENC(CHAIN)
      IF (CH.EQ.'I') THEN
         SUPPORT_ORIGIN = 0
         IF (FTYPE.EQ.'.nmb'.OR.FTYPE.EQ.'.NMB') THEN
            DATA_TYPE = .TRUE.
            CALL  INPUT_NMB(CHAIN,NFILE,ERROR,DATA_TYPE)
         ELSEIF (FTYPE.EQ.'.asc'.OR.FTYPE.EQ.'.ASC') THEN
            CALL  INPUT_ASC(CHAIN,NFILE,ERROR,DATA_TYPE)
         ELSEIF (FTYPE.EQ.'.fits'.OR.FTYPE.EQ.'.FITS') THEN
            CALL  INPUT_FITS(CHAIN,NFILE,ERROR,DATA_TYPE)
         ENDIF
         IF (ERROR) RETURN
      ELSEIF (CH.EQ.'O') THEN
         CALL MESSAGE(2,1,'FILE','FILE OUT not yet implemented')
c      elseif (ch.eq.'B') then
c         CALL MESSAGE(2,1,'FILE','FILE BOTH not implemented')
      ENDIF
      RETURN
*
99    CALL MESSAGE(2,1,'FILE','Open failed on file '//CHAIN)
      ERROR = .TRUE.
      END
*
      SUBROUTINE CHECK_EXTENSION (FTYPE, FLEN, ERROR)
      CHARACTER*(*) FTYPE
      INTEGER FLEN
      LOGICAL ERROR
*
      CHARACTER*60 MESS
*
      ERROR = .FALSE.
      IF (FLEN.EQ.4) THEN
         IF (FTYPE.EQ.'.smt'.OR.FTYPE.EQ.'.SMT') RETURN
         IF (FTYPE.EQ.'.nmb'.OR.FTYPE.EQ.'.NMB') RETURN
         IF (FTYPE.EQ.'.asc'.OR.FTYPE.EQ.'.ASC') RETURN
      ELSEIF (FLEN.EQ.5) THEN
         IF (FTYPE.EQ.'.iram'.OR.FTYPE.EQ.'.IRAM') RETURN
         IF (FTYPE.EQ.'.fits'.OR.FTYPE.EQ.'.FITS') RETURN
c        if (ftype.eq.'.sest') return
      ENDIF
      MESS = 'Invalid file extension '//FTYPE
      CALL MESSAGE(6,3,'FILE',MESS)
      ERROR = .TRUE.
      END
