musrsim/accel/com/MAKEWRITELOGOUT.FOR

99 lines
2.4 KiB
Fortran

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