GEANT321/geocad/gstset.F

   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