DataMuseum.dk

top - metrics - download

    Length: 864 (0x360)
    Types: TextFile
    Names: »block.f.orig«

└─⟦b20c6495f⟧ Bits:30007238 EUUGD18: Wien-båndet, efterår 1987
    └─⟦this⟧ »EUUGD18/General/Empire/block.f.orig« 

TextFile

	subroutine block ( amap )
c
c	This subroutine makes a copy of map ii into supplied file spec
c
	IMPLICIT INTEGER(A-Z)

	include 'common.h'
C
	character amap(6000)
	integer i

	isec=-1
	call clear
	call topini
	jector=-1
	call strout ( 'Output file: ' )
	call cflush
	call getstr ( tty, 20, i )
	call clear
	call topini
	tty ( i + 1 : i + 1 ) = '\0'
	open ( unit=2, file=tty, access='SEQUENTIAL',
     *	form='FORMATTED', status='NEW', err=600 )
	do 500 j=0,5900,100
	do 200 k=100,1,-1
	ab=amap(k+j)
200	if (ab.ne.' ') goto 300
	goto 500
300	do 400 l=1,k
400	g2(l)=amap(j+l)
	write(2,998) (g2(l),l=1,k)
998	format(1x,100a1)
500	continue
	close(unit=2)
	return

600	continue
	ptr = 0
	call addstr ( 'ERROR, Unable to open output file ', jnkbuf, ptr )
	call addstr ( tty, jnkbuf, ptr )
	jnkbuf ( ptr + 1 ) = '\0'
	call topmsg ( 1, jnkbuf )
	call cflush
	return
	end