	SUBROUTINE OPENFILES
C
C NEW SUBROUTINE WRITTEN JAN 2002 RJ ANGEL VTX
C
C WRITES PROGRAM HEADER TO UNIT 6
C REQUESTS ROOT FILENAME FROM USER AND OPENS FILES
C FOR DLS76
C
C COMPAQ-FORTRAN SPECIFIC
C

        CHARACTER*60 EXNAME
        CHARACTER*64 FNAME		! LONG FILE NAMES PERMITTED
        CHARACTER*2 BS,ES
        CHARACTER*72 STAR
      COMMON /BLOCK1/ NTIN,NTOUT,NFILEA,NFILEB,IFLAG	! DLS76 COMMON

C
C  STUFF FOR HEADER...
        BS=' *'
        ES='* '
        STAR='**********************************************************
     1**************'
C
C  SPECIFY FILESTREAMS (MOVED FROM DATIN)
      NTIN= 7
      NTOUT=12
      NFILEA=8
c
c set console to carriagecontrol=fortran
	OPEN(UNIT=6,FILE='CON',CARRIAGECONTROL='FORTRAN')

C
C WRITE SCREEN HEADER
      WRITE(6,10)BS,STAR,ES,BS,ES,BS,ES,BS,ES,BS,ES,BS,ES,BS,ES,
     1               BS,ES,BS,STAR,ES
C
C REQUEST EXPT NAME
100     WRITE(6,110)
110     FORMAT(//'$  INPUT EXPERIMENT NAME: ')
        READ(5,120,ERR=130)EXNAME
120     FORMAT(A60)
        IF(EXNAME(1:4) .EQ. 'EXIT' .OR. EXNAME(1:4) .EQ. 'exit')STOP
        IF(EXNAME(1:4) .EQ. 'QUIT' .OR. EXNAME(1:4) .EQ. 'quit')STOP
        IF(EXNAME(1:1) .NE. ' ')GOTO200
130     WRITE(6,140)EXNAME
140     FORMAT(/' ***** ERROR READING EXPERIMENT NAME:'/
     1     '(',A60,'WAS READ)')
        GOTO100
C
C BUILD FILE NAMES AND OPEN FILES
C
200     LEN=INDEX(EXNAME,'   ')-1			! ALLOW 2 SPACES IN FILENAME
C
C INPUT DATA FILE, EXTENSION .DLS UNIT=7
        FNAME=EXNAME(1:LEN)//'.DLS'
        OPEN(UNIT=NTIN,FILE=FNAME,STATUS='OLD',ACTION='READ',ERR=900)
C
C PRINT FILE FOR OUTPUT, EXTENSION .OUT, UNIT=12
        FNAME=EXNAME(1:LEN)//'.OUT'
        OPEN(UNIT=NTOUT,FILE=FNAME,STATUS='REPLACE',ACTION='WRITE',
     1  CARRIAGECONTROL='FORTRAN',ERR=900)
C NEW INPUT FILE, EXTENSION .NEW, UNIT=8
        FNAME=EXNAME(1:LEN)//'.NEW'
        OPEN(UNIT=NFILEA,FILE=FNAME,STATUS='REPLACE',ACTION='WRITE',
     1  ERR=900)
C
C  HEADER TO PRINT FILE
C
      WRITE(NTOUT,10)BS,STAR,ES,BS,ES,BS,ES,BS,ES,BS,ES,BS,ES,BS,ES,
     1               BS,ES,BS,STAR,ES
   10 FORMAT(//A2,A72,A2/A2,72X,A2/A2,72X,A2/
     1A2,11X,'                  DLS-76                         ',12X,A2/
     1A2,11X,'    ORIGINAL CODE BY BRUNO GUIGAS (KARLSRUHE)    ',12X,A2/
     1A2,11X,'   DEVELOPED BY BAERLOCHER & HEPP (ETH ZURICH)   ',12X,A2/
	1A2,11X,' PORTED TO COMPAQ FORTRAN JAN 2002, RJANGEL, VTX ',12X,A2/
     1A2,72X,A2/A2,A72,A2//)
C
	RETURN
C
C FILE OPEN ERROR
C
900     WRITE(6,910)FNAME
910     FORMAT(//' ***** ERROR OPENING FILE: ',A60//)
C
C CLOSE WINDOW UNDER USER CONTROL
920	WRITE(6,930)
930	FORMAT(' ***** HIT A <cr> TO CLOSE WINDOW'$)
	READ(5,940)
940	FORMAT(1X)
C
	STOP
      END
C

