*
* $Id: fmstgo.F,v 1.1.1.1 1996/03/07 15:17:36 mclareni Exp $
*
* $Log: fmstgo.F,v $
* Revision 1.1.1.1  1996/03/07 15:17:36  mclareni
* Fatmen
*
*
#include "fatmen/pilot.h"
      SUBROUTINE FMSTGO(GENAME,
     +        CFQNFA,CHSNFA,ICPLFA,IMTPFA,ILOCFA,CHSTFA,CHOSFA,
     +        CVSNFA,CVIDFA,IVIPFA,IDENFA,IVSQFA,IFSQFA,ISRDFA,
     +        IERDFA,ISBLFA,IEBLFA,CRFMFA,IRLNFA,IBLNFA,CFLFFA,
     +        CFUTFA,ICRTFA,ICTTFA,ILATFA,CCURFA,CCIDFA,CCNIFA,
     +        CCJIFA,IFPRFA,ISYWFA,IUSWFA,CUCMFA,
     +                  CHLINK,CHOPT,IRC)
      CHARACTER*(*)     GENAME,CHLINK,CHOPT
      PARAMETER         (LUNRZ=1)
      PARAMETER         (LUNFZ=2)
      CHARACTER*(*) CFQNFA
      CHARACTER*(*) CHSNFA
      CHARACTER*(*) CHSTFA
      CHARACTER*(*) CHOSFA
      CHARACTER*(*) CVSNFA,CVIDFA
      CHARACTER*(*) CFLFFA,CFUTFA,CRFMFA
      CHARACTER*(*) CCURFA,CCIDFA,CCNIFA,CCJIFA
      CHARACTER*(*) CUCMFA
      CHARACTER*2   KOPTS
      DIMENSION     ISYWFA(10),IUSWFA(10)
      PARAMETER     (JBIAS=2)
#include "fatmen/fatinfo.inc"
#include "fatmen/fatusr.inc"
#include "zebra/quest.inc"
#include "fatmen/fatpara.inc"
#include "fatmen/fmnkeys.inc"
      DIMENSION     KEYS(LKEYFA)
      PARAMETER (LURCOR=200000)
      COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
      DIMENSION    LQ(999),IQ(999),Q(999)
      EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
 
      IRC = 0
*
*     Check on input parameters
*
      LGN = LENOCC(GENAME)
      IF(LGN.EQ.0) GOTO 90
      IF(GENAME(1:2).NE.'//') GOTO 90
      ISLASH = INDEX(GENAME(3:LGN),'/')
      IF(ISLASH.EQ.0) GOTO 90
      ISLASH = ISLASH + 2
      JSLASH = INDEX(GENAME(ISLASH+1:LGN),'/')
      IF(JSLASH.EQ.0) GOTO 90
      JSLASH = JSLASH + ISLASH - 1
*
*     Initialise FATMEN
*
      CALL FMINIK(IXSTOR,LUNRZ,LUNFZ,GENAME(1:JSLASH),IRC)
      IF(IRC.NE.0) GOTO 99
 
      LFQNFA = LENOCC(CFQNFA)
      LHSNFA = LENOCC(CHSNFA)
      LHSTFA = LENOCC(CHSTFA)
      LHOSFA = LENOCC(CHOSFA)
      LVSNFA = LENOCC(CVSNFA)
      LVIDFA = LENOCC(CVIDFA)
      LFLFFA = LENOCC(CFLFFA)
      LFUTFA = LENOCC(CFUTFA)
      LRFMFA = LENOCC(CRFMFA)
      LCURFA = LENOCC(CCURFA)
      LCIDFA = LENOCC(CCIDFA)
      LCNIFA = LENOCC(CCNIFA)
      LCJIFA = LENOCC(CCJIFA)
      LUCMFA = LENOCC(CUCMFA)
*
*     Book the bank
*
      CALL FMBOOK(GENAME(1:LGN),KEYS,LADDBK,LSUP,JBIAS,IRC)
*
*     Zero/blank it according to I/O characteristic
*
      CALL DZZERO(IXSTOR,LADDBK)
      IQUEST(1) = 0
*
*     Character fields...
*
      IF(LFQNFA.GT.0) CALL UCTOH(CFQNFA,IQ(LADDBK+MFQNFA),4,LFQNFA)
      IF(LHSNFA.GT.0) CALL UCTOH(CHSNFA,IQ(LADDBK+MHSNFA),4,LHSNFA)
      IF(LHSTFA.GT.0) CALL UCTOH(CHSTFA,IQ(LADDBK+MHSTFA),4,LHSTFA)
      IF(LHOSFA.GT.0) CALL UCTOH(CHOSFA,IQ(LADDBK+MHOSFA),4,LHOSFA)
      IF(LVSNFA.GT.0) CALL UCTOH(CVSNFA,IQ(LADDBK+MVSNFA),4,LVSNFA)
      IF(LVIDFA.GT.0) CALL UCTOH(CVIDFA,IQ(LADDBK+MVIDFA),4,LVIDFA)
      IF(LFLFFA.GT.0) CALL UCTOH(CFLFFA,IQ(LADDBK+MFLFFA),4,LFLFFA)
      IF(LFUTFA.GT.0) CALL UCTOH(CFUTFA,IQ(LADDBK+MFUTFA),4,LFUTFA)
      IF(LRFMFA.GT.0) CALL UCTOH(CRFMFA,IQ(LADDBK+MRFMFA),4,LRFMFA)
      IF(LCURFA.GT.0) CALL UCTOH(CCURFA,IQ(LADDBK+MCURFA),4,LCURFA)
      IF(LCIDFA.GT.0) CALL UCTOH(CCIDFA,IQ(LADDBK+MCIDFA),4,LCIDFA)
      IF(LCNIFA.GT.0) CALL UCTOH(CCNIFA,IQ(LADDBK+MCNIFA),4,LCNIFA)
      IF(LCJIFA.GT.0) CALL UCTOH(CCJIFA,IQ(LADDBK+MCJIFA),4,LCJIFA)
      IF(LUCMFA.GT.0) CALL UCTOH(CUCMFA,IQ(LADDBK+MUCMFA),4,LUCMFA)
*
*     Integer fields...
*
      IQ(LADDBK+MCPLFA) = ICPLFA
      IQ(LADDBK+MMTPFA) = IMTPFA
      IQ(LADDBK+MLOCFA) = ILOCFA
      IQ(LADDBK+MVIPFA) = IVIPFA
      IQ(LADDBK+MDENFA) = IDENFA
      IQ(LADDBK+MVSQFA) = IVSQFA
      IQ(LADDBK+MFSQFA) = IFSQFA
      IQ(LADDBK+MSRDFA) = ISRDFA
      IQ(LADDBK+MERDFA) = IERDFA
      IQ(LADDBK+MSBLFA) = ISBLFA
      IQ(LADDBK+MEBLFA) = IEBLFA
      IQ(LADDBK+MRLNFA) = IRLNFA
      IQ(LADDBK+MBLNFA) = IBLNFA
      IQ(LADDBK+MCRTFA) = ICRTFA
      IQ(LADDBK+MCTTFA) = ICTTFA
      IQ(LADDBK+MLATFA) = ILATFA
      IQ(LADDBK+MFPRFA) = IFPRFA
*
*     Vectors...
*
      CALL UCOPY(ISYWFA,IQ(LADDBK+MSYWFA),10)
      CALL UCOPY(IUSWFA,IQ(LADDBK+MUSWFA),10)
*
*     Check that the bank is ok
*
      CALL FMUPKY(GENAME(1:LGN),LADDBK,KEYS,IRC)
      CALL FMVERI(GENAME(1:LGN),LADDBK,KEYS,'A',IRC)
      IF(IRC.NE.0) THEN
         PRINT *,'FMSTGO. error ',IRC,
     +           ' from FMVERI. Dare not use this bank'
         PRINT 9000,(IQUEST(I),I=1,26),(I,I=1,26)
9000     FORMAT(' IQUEST:',/,1X,26I3,/1X,26I3)
         RETURN
      ENDIF
*
*     Issue output stage
*
      CALL FMDD2L(CHLINK,LUN,IRC)
      LFMODE(LUN) = 2
      KOPTS = 'P'
      IF(IQ(LADDBK+MMTPFA).GT.1) KOPTS = 'NP'
      CALL FMCLOS(GENAME(1:LGN),CHLINK,LADDBK,KOPTS,IRC)
      LFMODE(LUN) = 0
*
*     Terminate FATMEN
*
      CALL FMENDK(IC)
      GOTO 99
 
   90 CONTINUE
      PRINT *,'FMSTGO. error - invalid generic name specified'
      IRC = 1
      GOTO 99
 
   99 CONTINUE
 
      END