Added to repository.

mutrack/com/MAKEWRITELOGOUT.FOR

@@ -0,0 +1,99 @@
+
+	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	(Arbeitet mit 'WRITELOG.COM' zusammen beim ausdrucken von Fileheadern)
+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='mutrack$OUTdirectory:MU_'//runNumber//'.LOG',status='OLD',
+     +	      readonly,iostat=iostat)
+
+	if (iostat.NE.0) then
+	    write(*,*)
+	    write(*,*)'can''t find mutrack$OUTdirectory:MU_'//runNumber//'.LOG'
+	    write(*,*)'-> STOP'
+	    write(*,*)
+	    STOP
+	endif
+
+
+c Oeffne WRITELOG_nnnn.OUT:
+
+	open (21,file='mutrack$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
+