*
* $Id$
*
* $Log$
* Revision 1.1  1996/03/07 15:18:20  mclareni
* Initial revision
*
*
#include "fatmen/pilot.h"
      SUBROUTINE FMMEDT(IRC)
*
*     Look for FATMEN.MEDTYPES file and read list
*     of media types and definitions
*
*     ==> N.B. these definitions OVERRIDE any previously set.
*
*     ==> N.B. the order of the definitions is SIGNIFICANT
*
*     ==> N.B. negative MEDIA-TYPE is defined but NOT SELECTED
*
*     FATMEN.MEDTYPES consists of blank separated fields.
*     All fields must be specified for a given device type,
*     otherwise that device type is skipped.
*
*     Although it is not assumed that the definitions are given
*     in the order of the media-type (integer), it is assumed
*     that there are no 'holes', i.e. if media type 4 is defined,
*     so must be media types 1-3.
*
*     The fields are as follows:
*
* MEDIA-TYPE DEVICE-TYPE GENERIC-TYPE DENSITY CAPACITY MOUNT-TYPE LABEL-TYPE
*
*     e.g.
*
* 2 3480 CT1 38K 200 M SL
* 3 3420 TAPE 6250 150 M SL
* 4 8200 8MM 43200 2300 M SL
* 5 8500 8MM 86400 5000 M SL
*
*
      CHARACTER*255 CHFILE,CHLINE
      LOGICAL       IEXIST
#include "fatmen/fatpara.inc"
#include "fatmen/fatmtp.inc"
#include "fatmen/fattyp.inc"
#include "fatmen/fatsys.inc"
#include "fatmen/fatbug.inc"
#include "fatmen/slate.inc"
 
      IRC    = 0
*
      LDEF   = LENOCC(DEFAULT)
 
#if defined(CERNLIB_CSPACK)
      IF(FATNOD.NE.' ') THEN
*
*     Open remote file. Here we are assuming that the remote
*     server is a Unix system
*
         CHFILE = DEFAULT(1:LDEF)//'/FATMEN.MEDTYPES'
         LFILE  = LENOCC(CHFILE)
         CALL CUTOL(CHFILE(1:LFILE))
*
*     Does file exist?
*
         CALL XZINQR(LUFZFA,CHFILE(1:LFILE),FATNOD,ICODE,LRECL,IRC)
         IF(ICODE.NE.0) THEN
            IF(IDEBFA.GE.2) PRINT *,'FMMEDT. FATMEN.MEDTYPES file ',
     +      'does not exist (',CHFILE(1:LFILE),')'
            GOTO 50
         ENDIF
         LRECL  = 80
         CALL XZOPEN(LUFZFA,CHFILE(1:LFILE),FATNOD,LRECL,'F',IRC)
 
      ELSE
 
#endif
#if defined(CERNLIB_UNIX)
         CHFILE = DEFAULT(1:LDEF)//'/FATMEN.MEDTYPES'
         CALL CUTOL(CHFILE)
#endif
#if defined(CERNLIB_VAXVMS)
         CHFILE = DEFAULT(1:LDEF)//'FATMEN.MEDTYPES'
#endif
#if defined(CERNLIB_IBMVM)
         CHFILE = '/FATMEN MEDTYPES '//SERMOD
#endif
#if defined(CERNLIB_IBMMVS)
         CHFILE = '/'//DEFAULT(1:LDEF)//'FATMEN.MEDTYPES'
#endif
         LFILE = LENOCC(CHFILE)
*
*     Does file exist?
*
         INQUIRE(FILE=CHFILE(1:LFILE),EXIST=IEXIST)
 
         IF(.NOT.IEXIST) THEN
            IF(IDEBFA.GE.2) PRINT *,'FMMEDT. FATMEN.MEDTYPES file ',
     +      'does not exist (',CHFILE(1:LFILE),')'
            GOTO 50
         ENDIF
*
*     Open and read the file
*
#if defined(CERNLIB_IBMVM)
         OPEN(LUFZFA,FILE=CHFILE(1:LFILE),ACTION='READ', ACCESS=
     +   'SEQUENTIAL',FORM='UNFORMATTED', STATUS='OLD',IOSTAT=IRC)
#endif
#if defined(CERNLIB_IBMMVS)
         CALL KUOPEN(LUFZFA,CHFILE(1:LFILE),'OLD',IRC)
#endif
#if defined(CERNLIB_VAXVMS)
         ISTAT = LIB$GET_LUN(LUNACC)
         IF(.NOT.ISTAT) THEN
            IRC = 42
            IF(IDEBFA.GE.-3) PRINT *,'FMMEDT. could not assign logical '
     +      , 'unit to read location codes file'
            GOTO 50
         ENDIF
 
         OPEN(LUNACC,FILE=CHFILE(1:LFILE),READONLY,ACCESS='SEQUENTIAL',
     +   STATUS='OLD',FORM='FORMATTED',IOSTAT=IRC)
 
#endif
#if defined(CERNLIB_UNIX)
         CALL CIOPEN(LUNACC,'r',CHFILE(1:LFILE),IRC)
#endif
#if defined(CERNLIB_CSPACK)
      ENDIF
#endif
      IF(IRC.NE.0) THEN
         IF(IDEBFA.GE.-3) PRINT *,'FMMEDT. error ',IRC,' opening ',
     +      CHFILE(1:LFILE)
         GOTO 50
      ENDIF
 
*
*     Save and clear number of media types
*
      NFMOLD = NFMTYP
      NFMTYP = 0
*
*     Save and clear media type selection vector
*
      NUMOLD = NUMMTP
      NUMMTP = 0
*
   10 CONTINUE
#if defined(CERNLIB_CSPACK)
      IF(FATNOD.NE.' ') THEN
         CALL XZGETL(LUFZFA,CHLINE,'(A)',' ',IRC)
         IF(IRC.NE.0) GOTO 30
         LLINE = LENOCC(CHLINE)
      ELSE
#endif
#if defined(CERNLIB_IBMVM)
         READ(LUFZFA,NUM=LLINE,END=30) CHLINE
#endif
#if defined(CERNLIB_IBMMVS)
         READ(LUFZFA,'(A)',END=30) CHLINE
         LLINE = LENOCC(CHLINE)
#endif
#if defined(CERNLIB_VAXVMS)
         READ(LUNACC,'(A)',END=30) CHLINE
         LLINE = LENOCC(CHLINE)
#endif
#if defined(CERNLIB_UNIX)
         CALL FMCFGL(LUNACC,CHLINE,LLINE,' ',ISTAT)
         IF(ISTAT.NE.0) GOTO 30
#endif
#if defined(CERNLIB_CSPACK)
      ENDIF
#endif
 
      IF(LLINE.EQ.0) GOTO 10
      IF(IDEBFA.GE.3) PRINT *,'FMMEDT. read ',CHLINE(1:LLINE)
*
*     Comments...
*
      IF(CHLINE(1:1).EQ.'!')  GOTO 10
      IF(CHLINE(1:1).EQ.'*')  GOTO 10
      IF(CHLINE(1:1).EQ.'#')  GOTO 10
*        G.Folger       "/*" is bad for cpp, so split it...
      IF(CHLINE(1:1).EQ.'/' .AND. CHLINE(2:2).EQ.'*' ) GOTO 10
 
      NFMTYP = NFMTYP + 1
      IF(NFMTYP.GT.NMTYP) THEN
         IF(IDEBFA.GE.-3) PRINT 9001,NMTYP
 9001 FORMAT(' FMMEDT. cannot process any more media definitions.',
     +      '  Maximum number = ',I10)
         GOTO 40
      ENDIF
 
      LEND = LLINE
*
*     Media-type
*
      I = ICDECI(CHLINE,1,LEND)
      J = IABS(I)
      IF(J.GT.NMTYP) THEN
         IF(IDEBFA.GE.-3) PRINT 9002,J,NMTYP
 9002 FORMAT(' FMMEDT. media type ',I10,
     +      ' outside range. Maximum allowed value = ',I10)
            GOTO 20
      ENDIF
 
      IF(J.EQ.0) THEN
         IF(IDEBFA.GE.-3) PRINT 9003,J
 9003 FORMAT(' FMMEDT. invalid media type ',I10,
     +      ' ignored. Specify a nonzero integer')
            GOTO 20
      ENDIF
 
*
*     Label-type
*
      LSTART = INDEXB(CHLINE(1:LEND),' ')
      IF(LSTART.EQ.0) GOTO 20
 
      CHMLAB(J) = CHLINE(LSTART+1:LEND)
      LEND   = LSTART - 1
*
*     Mount-type
*
      LSTART = INDEXB(CHLINE(1:LEND),' ')
      IF(LSTART.EQ.0) GOTO 20
 
      CHMMNT(J) = CHLINE(LSTART+1:LEND)
      LEND   = LSTART - 1
*
*     Capacity
*
      LSTART = INDEXB(CHLINE(1:LEND),' ')
      IF(LSTART.EQ.0) GOTO 20
 
      CHMSIZ(J) = CHLINE(LSTART+1:LEND)
      MEDSIZ(J) = ICDECI(CHLINE,LSTART+1,LEND)
      LEND   = LSTART - 1
*
*     Density
*
      LSTART = INDEXB(CHLINE(1:LEND),' ')
      IF(LSTART.EQ.0) GOTO 20
 
      CHMDEN(J) = CHLINE(LSTART+1:LEND)
      MEDDEN(J) = ICDECI(CHLINE,LSTART+1,LEND)
      IF(INDEX(CHLINE(LSTART+1:LEND),'K').NE.0) MEDDEN(J) =
     +   MEDDEN(J)*1000
      LEND   = LSTART - 1
*
*     Generic-type
*
      LSTART = INDEXB(CHLINE(1:LEND),' ')
      IF(LSTART.EQ.0) GOTO 20
 
      CHMGEN(J) = CHLINE(LSTART+1:LEND)
      LEND   = LSTART - 1
*
*     Device-type
*
      LSTART = INDEXB(CHLINE(1:LEND),' ')
      IF(LSTART.EQ.0) GOTO 20
 
      CHMTYP(J) = CHLINE(LSTART+1:LEND)
      LEND   = LSTART - 1
 
      IF(I.GT.0) THEN
*
*     Set also selection vector
*
        NUMMTP = NUMMTP + 1
        MFMMTP(NUMMTP) = J
      ELSE
        IF(IDEBFA.GE.1) PRINT 9005,J
 9005 FORMAT(' FMMEDT. media type ',I10,
     +       ' booked but not selected')
      ENDIF
 
      GOTO 10
 
   20 CONTINUE
 
      IF(IDEBFA.GE.0) WRITE(LPRTFA,9004) CHLINE(1:LLINE)
 9004 FORMAT(' FMMEDT. skipping invalid line - ',A)
      NFMTYP = NFMTYP - 1
      GOTO 10
 
   30 CONTINUE
      IF((NFMTYP.LE.0).OR.(NUMMTP.LE.0)) THEN
        NFMTYP = NFMOLD
        NUMMTP = NUMOLD
        IRC = 1
      ENDIF
 
#if defined(CERNLIB_CSPACK)
      IF(FATNOD.NE.' ') THEN
         CALL XZCLOS(LUFZFA,' ',ISTAT)
      ELSE
#endif
#if defined(CERNLIB_IBM)
         CLOSE(LUFZFA)
#endif
#if defined(CERNLIB_VAXVMS)
         CLOSE(LUNACC)
         CALL LIB$FREE_LUN(LUNACC)
#endif
#if defined(CERNLIB_UNIX)
         CALL FMCFGL(LUNACC,CHLINE,LLINE,'F',ISTAT)
         CALL CICLOS(LUNACC)
#endif
#if defined(CERNLIB_CSPACK)
      ENDIF
#endif
 
      RETURN
 
   40 CONTINUE
      IRC = 1
      GOTO 30
 
   50 CONTINUE
      IRC = 1
      END
