[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / fq / fzodat.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1996/03/06 10:47:13  mclareni
* Zebra
*
*
#include "zebra/pilot.h"
      SUBROUTINE FZODAT (LUNP,IXDIVP,LENTP)

C-    Write Direct Access Table

#include "zebra/zunit.inc"
#include "zebra/mqsys.inc"
#include "zebra/eqlqf.inc"
#include "zebra/fzcx.inc"
C--------------    End CDE                             --------------
      DIMENSION    LUNP(9), IXDIVP(9), LENTP(9), IUHEAD(8)
#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
      DIMENSION    NAMESR(2)
      DATA  NAMESR / 4HFZOD, 4HAT   /
#endif
#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
      DATA  NAMESR / 6HFZODAT /
#endif
#if !defined(CERNLIB_QTRHOLL)
      CHARACTER    NAMESR*8
      PARAMETER   (NAMESR = 'FZODAT  ')
#endif
      DATA  IUHEAD / 8*0 /


#include "zebra/qtrace.inc"

      LUNNX   = LUNP(1)
      CALL FZLOC (LUNNX,2)
#if defined(CERNLIB_QDEBPRI)
      IF (LOGLVX.GE.2)  WRITE (IQLOG,9002) LUNX
 9002 FORMAT (' FZODAT-  called for LUN=',I4)
#endif

C----              Write the DAT forward reference record

      IF (LENTP(1).NE.0)           GO TO 24
      IPILX(3) = 2
      CALL FZOUT (LUNX, 0,0, 1, 'Z', 1,8,IUHEAD)
      IPILX(3) = 0
      IACTVX   = 14
      IQ(KQSP+LQFX+2) = IACTVX
      GO TO 999

C----              Write the d/a table record

   24 IPILX(3) = 1
      CALL FZOUT (LUNX, IXDIVP,LENTP, 1, 'S', 0,0,0)
      IPILX(3)  = 0
      IQ(KQSP+LQFX+34) = IQUEST(5)
      IQ(KQSP+LQFX+35) = IQUEST(6)

C--                Try to update the DAT forward reference record

#if defined(CERNLIB_FZDACC)
      IF (IFIFOX.NE.2)             GO TO 999
C--       flush the buffer
      CALL FZOUT (LUNX, -7,0, 13, 'FZEND', 0,0,0)
C--       update
      CALL FZUDAT (LUNP,0)
      LUNX = -1
#endif

#include "zebra/qtrace99.inc"
      RETURN
      END
*      ==================================================
#include "zebra/qcardl.inc"
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
	6	* Zebra
	7	*
	8	*
	9	#include "zebra/pilot.h"
	10	SUBROUTINE FZODAT (LUNP,IXDIVP,LENTP)
	11
	12	C- Write Direct Access Table
	13
	14	#include "zebra/zunit.inc"
	15	#include "zebra/mqsys.inc"
	16	#include "zebra/eqlqf.inc"
	17	#include "zebra/fzcx.inc"
	18	C-------------- End CDE --------------
	19	DIMENSION LUNP(9), IXDIVP(9), LENTP(9), IUHEAD(8)
	20	#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
	21	DIMENSION NAMESR(2)
	22	DATA NAMESR / 4HFZOD, 4HAT /
	23	#endif
	24	#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
	25	DATA NAMESR / 6HFZODAT /
	26	#endif
	27	#if !defined(CERNLIB_QTRHOLL)
	28	CHARACTER NAMESR*8
	29	PARAMETER (NAMESR = 'FZODAT ')
	30	#endif
	31	DATA IUHEAD / 8*0 /
	32
	33
	34	#include "zebra/qtrace.inc"
	35
	36	LUNNX = LUNP(1)
	37	CALL FZLOC (LUNNX,2)
	38	#if defined(CERNLIB_QDEBPRI)
	39	IF (LOGLVX.GE.2) WRITE (IQLOG,9002) LUNX
	40	9002 FORMAT (' FZODAT- called for LUN=',I4)
	41	#endif
	42
	43	C---- Write the DAT forward reference record
	44
	45	IF (LENTP(1).NE.0) GO TO 24
	46	IPILX(3) = 2
	47	CALL FZOUT (LUNX, 0,0, 1, 'Z', 1,8,IUHEAD)
	48	IPILX(3) = 0
	49	IACTVX = 14
	50	IQ(KQSP+LQFX+2) = IACTVX
	51	GO TO 999
	52
	53	C---- Write the d/a table record
	54
	55	24 IPILX(3) = 1
	56	CALL FZOUT (LUNX, IXDIVP,LENTP, 1, 'S', 0,0,0)
	57	IPILX(3) = 0
	58	IQ(KQSP+LQFX+34) = IQUEST(5)
	59	IQ(KQSP+LQFX+35) = IQUEST(6)
	60
	61	C-- Try to update the DAT forward reference record
	62
	63	#if defined(CERNLIB_FZDACC)
	64	IF (IFIFOX.NE.2) GO TO 999
65	C-- flush the buffer
66	CALL FZOUT (LUNX, -7,0, 13, 'FZEND', 0,0,0)
67	C-- update
68	CALL FZUDAT (LUNP,0)
69	LUNX = -1
70	#endif
71
72	#include "zebra/qtrace99.inc"
73	RETURN
74	END
75	* ==================================================
76	#include "zebra/qcardl.inc"