[u/mrichter/AliRoot.git] / GEANT321 / geocad / gstset.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:20:47  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.32  by  S.Giani
*-- Author :
      SUBROUTINE GSTSET(FNAME,ANAME,INST,SITE,DEPT,RESP)
*
*
*      This subroutine starts a SET file.
*
*      It writes the beginning of the file, with a relevant header
*      A SET data assembly is intialized after the header.
*
#include "geant321/gcsetf.inc"
#include "geant321/gcunit.inc"
 
*
* *** name of the SET-file:
      CHARACTER*24    FNAME
      CHARACTER*80    FNAMES
* *** name of the data assembly:
      CHARACTER*4    ANAME
      CHARACTER*8     DATE,TIME
      CHARACTER*24    INST,SITE,DEPT,RESP
*
* *** File name and other general input to be read in by the user **
      IF(INDEX(FNAME,'.').EQ.0) THEN
         IT=LNBLNK(FNAME)
      ELSE
         IT=INDEX(FNAME,'.')-1
      ENDIF
#if !defined(CERNLIB_IBM)
      FNAMES=FNAME(1:IT)//'.set'
#endif
#if defined(CERNLIB_IBM)
      FNAMES='/'//FNAME(1:MIN(IT,8))//' SET A1'
      CALL CLTOU(FNAMES)
#endif
*
      OPEN (UNIT=NUNIT1, FILE=FNAMES, STATUS='UNKNOWN', ERR=10 )
*
* *** library call for date and time:
      CALL DATIMH (DATE,TIME)
*
      NPLACE = 1
      BLKSTR = ' '
      JVSTR  = ' '
      WRITE (BLKSTR,10000) INST,SITE,DEPT,RESP
      CALL GJWRIT
*   the last line:
      WRITE (NUNIT1,'(A80)') JVSTR
      JVSTR  = ' '
*
      WRITE (NUNIT1,10100) DATE(7:8),DATE(4:5),DATE(1:2),
     +                     TIME(1:2),TIME(4:5),TIME(7:8)
*
      NPLACE = 1
      BLKSTR = ' '
      WRITE (BLKSTR,10200) ANAME
      CALL GJWRIT
*   the last line:
      WRITE(NUNIT1,'(A80)')JVSTR
      JVSTR = ' '
*
      WRITE (NUNIT1,'(A)') ',1,0.01,0,-300.,300.,-300.,300.,-300.,300.'
      WRITE (NUNIT1,'(A)') '#9920,:12,0.005,:14,0,:15,0'
      WRITE (NUNIT1,'(A)') '@301,2#301,1.,0.,0.,0.,1.
     + ,0.,0.,0.,1.,0.,0.,0.'
*
      RETURN
*
   10 WRITE(CHMAIL,'('' Error opening the .SET file. '')')
      CALL GMAIL(0,0)
      WRITE(CHMAIL,'(''Check your directory and unit number in use'')')
      CALL GMAIL(0,0)
      WRITE(CHMAIL,'('' CADINT cannot proceed. Program terminated '')')
      CALL GMAIL(0,0)
      STOP
*
10000 FORMAT('@9900#9900,''Z68-300.89.06'',''2.0'',''
     +CADINT'',''1.20'',''',A,''',''',A,''',''',A,
     +''',''',A,'''')
10100 FORMAT('#9901,19',A2,',',A2,',',A2,',',A2,',',A2,',',A2)
10200 FORMAT('@9901,1,''',A4,'''#9905,3,1.')
*
      END
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.1.1.1 1995/10/24 10:20:47 cernlib
	6	* Geant
	7	*
	8	*
	9	#include "geant321/pilot.h"
	10	*CMZ : 3.21/02 29/03/94 15.41.32 by S.Giani
	11	*-- Author :
	12	SUBROUTINE GSTSET(FNAME,ANAME,INST,SITE,DEPT,RESP)
	13	*
	14	*
	15	* This subroutine starts a SET file.
	16	*
	17	* It writes the beginning of the file, with a relevant header
	18	* A SET data assembly is intialized after the header.
	19	*
	20	#include "geant321/gcsetf.inc"
	21	#include "geant321/gcunit.inc"
	22
	23	*
	24	* *** name of the SET-file:
	25	CHARACTER*24 FNAME
	26	CHARACTER*80 FNAMES
	27	* *** name of the data assembly:
	28	CHARACTER*4 ANAME
	29	CHARACTER*8 DATE,TIME
	30	CHARACTER*24 INST,SITE,DEPT,RESP
	31	*
	32	* * File name and other general input to be read in by the user
	33	IF(INDEX(FNAME,'.').EQ.0) THEN
	34	IT=LNBLNK(FNAME)
	35	ELSE
	36	IT=INDEX(FNAME,'.')-1
	37	ENDIF
	38	#if !defined(CERNLIB_IBM)
	39	FNAMES=FNAME(1:IT)//'.set'
	40	#endif
	41	#if defined(CERNLIB_IBM)
	42	FNAMES='/'//FNAME(1:MIN(IT,8))//' SET A1'
	43	CALL CLTOU(FNAMES)
	44	#endif
	45	*
	46	OPEN (UNIT=NUNIT1, FILE=FNAMES, STATUS='UNKNOWN', ERR=10 )
	47	*
	48	* *** library call for date and time:
	49	CALL DATIMH (DATE,TIME)
	50	*
	51	NPLACE = 1
	52	BLKSTR = ' '
	53	JVSTR = ' '
	54	WRITE (BLKSTR,10000) INST,SITE,DEPT,RESP
	55	CALL GJWRIT
	56	* the last line:
	57	WRITE (NUNIT1,'(A80)') JVSTR
	58	JVSTR = ' '
	59	*
	60	WRITE (NUNIT1,10100) DATE(7:8),DATE(4:5),DATE(1:2),
	61	+ TIME(1:2),TIME(4:5),TIME(7:8)
	62	*
	63	NPLACE = 1
	64	BLKSTR = ' '
65	WRITE (BLKSTR,10200) ANAME
66	CALL GJWRIT
67	* the last line:
68	WRITE(NUNIT1,'(A80)')JVSTR
69	JVSTR = ' '
70	*
71	WRITE (NUNIT1,'(A)') ',1,0.01,0,-300.,300.,-300.,300.,-300.,300.'
72	WRITE (NUNIT1,'(A)') '#9920,:12,0.005,:14,0,:15,0'
73	WRITE (NUNIT1,'(A)') '@301,2#301,1.,0.,0.,0.,1.
74	+ ,0.,0.,0.,1.,0.,0.,0.'
75	*
76	RETURN
77	*
78	10 WRITE(CHMAIL,'('' Error opening the .SET file. '')')
79	CALL GMAIL(0,0)
80	WRITE(CHMAIL,'(''Check your directory and unit number in use'')')
81	CALL GMAIL(0,0)
82	WRITE(CHMAIL,'('' CADINT cannot proceed. Program terminated '')')
83	CALL GMAIL(0,0)
84	STOP
85	*
86	10000 FORMAT('@9900#9900,''Z68-300.89.06'',''2.0'',''
87	+CADINT'',''1.20'',''',A,''',''',A,''',''',A,
88	+''',''',A,'''')
89	10100 FORMAT('#9901,19',A2,',',A2,',',A2,',',A2,',',A2,',',A2)
90	10200 FORMAT('@9901,1,''',A4,'''#9905,3,1.')
91	*
92	END