C                     
C	
C   TEYSEC.FOR	
C*  **********************************************
C
	COMMON //NX,NY,NZ,IXMIN,IYMIN,IZMIN,IXMAX,IYMAX,IZMAX
	DIMENSION NXYZ(3),MXYZ(3),NXYZST(3)
c	CHARACTER*80 TITLE
	DIMENSION IXYZMIN(3),IXYZMAX(3)
	CHARACTER*50 INFILE,OUTFILE,FILENAME
        CHARACTER*40 FNAME,ASTRING
	CHARACTER*1 OUTSTRING(1200),HSTRING(16),BOXFLAG
	LOGICAL EFLG
	character LABEL*80,title*80,junk*2
C	character*1 aline(28),bline(131072),CLINE(131072)
	integer*2 inta(14),intb(65536),ZLP
	integer*4 linta(7),n,ii,ylayer
	REAL*4 REALB(32768),REALC(32768)
	pi=4*ATAN(1.)
	R64K=256*256
 	R32K=128*256
 
	WRITE(6,1000)
1000	FORMAT(//' TEY DENSITY MAP RESECTIONING PROGRAM Version 920901'//
     .  'EXCHANGES SLOW AXIS WITH SECTION AXIS IN .TEY FORMAT MAPS.'//
     .  'CHANGES Y-SECTIONS FOR Z-SECTIONS AND VICE VERSA. FAST IS X.')
5	WRITE(6,1100)
1100	FORMAT(/'$Input filename (CR to quit):  ')
	READ(5,1200) INFILE
1200	FORMAT(A)
	IF (INFILE(:5).EQ.'     ') STOP
	  INQUIRE(FILE=INFILE, NAME=FILENAME,EXIST=EFLG)
	WRITE(6,*)'INFILE=',INFILE,'EFLG=',EFLG,' FILENAME=',FILENAME
	  IF (.NOT.EFLG) GOTO 5
        OPEN (UNIT=2,FILE=INFILE,STATUS='OLD',form='unformatted')

	read(2) title
11	format (A2,a80)
	write(6,*)title

	write(6,*)' Enter last section to include, or "0" to include all:'
	read(5,*) izlast
	write(6,*)' Enter scale facto to multiply output map by:'
	read(5,*)dscale
	write(6,*)'xm=',xm
c	IF (XM.GT.0) GOTO 87
	TYPE *,'READING IMAGE. FIRST PASS: FINDING MIN, MAX DENSITY'
	DMEAN=0
	DMAX=-1E32
	DMIN=1E32
	NY=0
	IYMIN=10000
	IYMAX=-10000
20	read(2) (linta(i),i=2,6)
21	format(A2,24a1)
c	write(6,31) (inta(i),i=1,12)
31	format(' ',14i6)
	ylayer=linta(2)
	if(ylayer.LT.0) goto 985
	IF (ylayer.lt.iymin)iymin=ylayer	
	IF (ylayer.gt.iymax)iymax=ylayer	
	IXMIN=linta(3)
	IXMAX=linta(4)
	IZMIN=linta(5)
	IZMAX=linta(6)
	write(6,33) ylayer,IXMIN,IXMAX,IZMIN,IZMAX
33	FORMAT(' ylayer:',I5,' IXMIN:',I5,' IXMAX:',I5,' IZMIN:',I5,
     .  ' IZMAX',I5)

	nx=(1+IXMAX-IXMIN)
	nz=(1+IZMAX-IZMIN)
	ny=NY+1
	n=nx*nz
	read(2) (realb(ii),ii=1,n)
41	format(2x,2042a1)
51	FORMAT('AA',2042A1)

C	do 80 i=1,nz
C110	write(6,111)IZMIN+i-1,(REALB(j),j=1+(i-1)*nx,i*nx)
111	FORMAT(' ',I6,7F12.3)
    	goto 20

985	CLOSE(UNIT=2)
	if (izlast.eq.0) izlast=izmax
               
        
	OPEN (UNIT=3,FILE='ZSEC.TEY',STATUS='NEW',RECL=2042,form='unformatted')

	WRITE (3) TITLE
61	format(a80)
	write(6,*)'infile=',infile
	write(6,*)'izmin,max=',izmin,izmax
	DO 95 ZLP=IZMIN,IZLAST
	WRITE(6,*)'ZLP=',ZLP
        OPEN (UNIT=2,FILE=INFILE,STATUS='OLD',form='unformatted')
C	SKIP OVER HEADER FOR NOW:
	read(2) title
	write(6,*)'title=',title
	DO 90 k=1,ny
120	read(2)(linta(i),i=2,6)
c	write(6,31) (inta(i),i=1,12)
	ylayer=linta(2)
	IXMAX=linta(4)
C	write(6,*) 'ylayer=',ylayer,' ixmax=',ixmax
	if(ylayer.eq.-1) goto 5000
	read(2) (realb(ii),ii=1,n)
                                                 
C	write(6,*)'ylayer=',ylayer,'  nz=',nz
	i=1+zlp-IZMIN
c110	write(6,111)IZMIN+i-1,(REALB(j),j=1+(i-1)*nx,i*nx)
C	write(6,*)'nx=',nx,' nx2=',nx2,' X0=',X0,' Scale=',scale
	do  90,j=1,nx
C	x=REALB(j+(i-1)*nx)
C	x=REALB(j+(ZLP-IZMIN)*nx)
90	REALC(J+(YLAYER-IYMIN)*NX) = dscale*REALB(j+(ZLP-IZMIN)*nx)
C	write(6,*)x
C  REARANGE record header for z sections, ymin to ymax
	LINTA(2)=ZLP
	LINTA(5)=IYMIN
	LINTA(6)=IYMAX
	WRITE(3) (LINTA(I),I=2,6)
	WRITE(3)(REALC(II),II=1,NX*NY)
95	CLOSE (UNIT=2)

5000	do 5010 i=2,6
5010	LINTA(I)=-1
	WRITE(3) (LINTA(I),I=2,6)
C  (NEGATIVE NUMBERS INDICATE NO MORE SECTIONS TO READ)
	close (unit=3)
	END