OPTIONS /EXTEND_SOURCE

c	PROGRAM WRITELOG
c	================

c===============================================================================
c       Dieses Programm uebernimmt aus der Command Zeile eine Runnummer und
c	uebertraegt den Header des zugehoerigen Logfiles in WRITELOG_nnnn.OUT. 
c       gleich wieder loescht.
c===============================================================================

	IMPLICIT NONE

c Deklarationen fuer das Einlesen der Runnummer von der Commandline:

        external    cli$get_value
        integer     cli$get_value
        integer     status

        character*4   runNumber
        integer     length

 
c sonstige Deklarationen:

	character*80	zeile
	integer		i,iostat,marke
	logical		flag

c-------------------------------------------------------------------------------


c Lies Runnummer aus Commandline:

        status = cli$get_value('runNumber',runNumber,length)
        if (.NOT.status) call lib$signal(%val(status))
        call str$trim(runNumber,runNumber,length)


c Oeffne zugehoeriges LOGfile:

	open (20,file='accel$OUTdirectory:AC_'//runNumber//'.LOG',status='OLD',
     +	      readonly,iostat=iostat)

	if (iostat.NE.0) then
	    write(*,*)
	    write(*,*)'can''t find accel$OUTdirectory:AC_'//runNumber//'.LOG'
	    write(*,*)'-> STOP'
	    write(*,*)
	    STOP
	endif


c Oeffne WRITELOG_nnnn.OUT:

	open (21,file='accel$OUTdirectory:WRITELOG_'//runNumber//'.OUT',
     +		      status='NEW')


c Uebertrage die Headerzeilen:

c       do i = 1, 130
c           read(20,'(A)',end=20)  zeile
c           write(21,'(xA)') zeile
c       enddo
c       write(21,*)
c       write(21,*)'  >>>>>>>>>> AUSDRUCK HIER ABGEBROCHEN >>>>>>>>>>'

c - Teste, ob LOGfile mehr als 140 Zeilen hat. Falls ja, drucke nur den
c   Haeder. Andernfalls drucke das ganze Logfile

        flag = .false.
        marke = -10
        do i = 1, 141
            read(20,'(A)',end=10)  zeile
            if (index(Zeile,'>>>>> T E S T - R U N <<<<<').NE.0) marke = i
        enddo
        flag = .true.           ! -> nur Headerzeilen schreiben

10      rewind (20)
	do i = 1, 140
            read(20,'(A)',end=20)  zeile
            if (flag .AND. index(Zeile,'>>> Schleife  :').NE.0) goto 20
            if (i.NE.marke .AND. i.NE.marke+1) then
                write(21,'(xA)') zeile
            endif
        enddo
 

c Schliesse die Files:

20	close (20)
	close (21)


	END