	PROGRAM ARBSECT
	PARAMETER MAXSIZ=6000
C
C     PROGRAM TO READ A FOURIER MAP GENERATED BY THE FINGER FOURIER
C     PROGRAM AND COMPUTE AN ARBITRARY SECTION.
	DIMENSION LINE(33),POINTS(3,3),A(4),TITLE(18),FY(15),JDEX(4)
	1,CELL(6),JSECT(200)
	REAL ILINE(1),BUFF(MAXSIZ)
	INTEGER FRMT(2)
	EQUIVALENCE (BUFF,ILINE),(JDEX(1),IP1),(JDEX(2),IP2),(JDEX(3),IP3)
	1,(JDEX(4),IP4)
	DATA FRMT/1H ,1H0/
	DATA IN,IOUT,ISC,ISC1/5,6,11,12/
    1 FORMAT(1H1,18A4)
    2 FORMAT(18A4)
    3 FORMAT(10I3)
    4 FORMAT(1H1,18A4,'   PAGE',I3,'  OF APPARENT SECTION',I3//F10.0,14F
	18.0)
    5 FORMAT('0IMPROPER SECTION SELECTION, JOB ABORTED.')
    6 FORMAT('0  SECTION SAVED FOR LATER PLOTTING')
    8 FORMAT('0  FRACTIONAL COORDINATES OF CORNERS:',(T45,3F10.5))
    9 FORMAT('0  LENGTH OF TRANSFORMED X =',F13.3/'   LENGTH OF TRANSFOR
	1MED Y =',F13.3/'   ANGLE BETWEEN TRANS. X AND Y =',F8.3)
   10 FORMAT('   EQUATION OF SECTION IS',F10.4,' X +',F10.4,' Y +',F10.4
	1,' Z +',F10.4,' = 0.0')
   12 FORMAT(9F8.0,I2)
   14 FORMAT(A1,I3,'. ',30I4)
C
C        INITIALIZE CORE REQUIREMENTS
   15 READ(IN,2,END=900)TITLE
	READ(IN,3)IO,IZO,ISPC,IMRK,IYI,IYF,IZI,IZF
	READ(IN,12)CELL
	DO 18 I=4,6
   18 CELL(I)=COS(CELL(I)*.017453)
	ISPC=MOD(IABS(ISPC),2)+1
	WRITE(IOUT,1)TITLE
	REWIND ISC
	READ(IN,12)POINTS,ITP
	INIT=-1
   30 READ(ISC,END=100)JXA,JYA,KZC,IZ,IX,IXI,IXF,IY,JYI,JYF,JZI,JZF
	INIT=INIT+1
	IF(INIT.NE.0)GO TO 35
	IF(IMRK.NE.0)GO TO 300
	IYI=JYI
	IZI=JZI
	IYF=JYF
	IZF=JZF
  300 IF(ITP.EQ.0)GO TO 32
C        CONVERT FRACTIONAL TO MAP COORDINATES
	DO 31 I=1,3
	POINTS(1,I)=POINTS(1,I)*IX
	POINTS(2,I)=POINTS(2,I)*IY
   31 POINTS(3,I)=POINTS(3,I)*IZ
C        CALCULATE EQUATION OF PLANE
   32 A(1)=(POINTS(2,2)-POINTS(2,1))*(POINTS(3,3)-POINTS(3,1))-(POINTS(3
	1,2)-POINTS(3,1))*(POINTS(2,3)-POINTS(2,1))
	A(2)=(POINTS(3,2)-POINTS(3,1))*(POINTS(1,3)-POINTS(1,1))-(POINTS(1
	1,2)-POINTS(1,1))*(POINTS(3,3)-POINTS(3,1))
	A(3)=(POINTS(1,2)-POINTS(1,1))*(POINTS(2,3)-POINTS(2,1))-(POINTS(2
	1,2)-POINTS(2,1))*(POINTS(1,3)-POINTS(1,1))
	A(4)=-(A(1)*POINTS(1,1)+A(2)*POINTS(2,1)+A(3)*POINTS(3,1))
	WRITE(IOUT,10)A
	IF(IO.NE.0)WRITE(IOUT,6)
	IF(ABS(A(1)).GT.1.0E-10)GO TO 33
  320 WRITE(IOUT,5)
	STOP
   33 DO 20 I=2,4
   20 A(I)=-A(I)/A(1)
C        COMPUTE COORDINATES OF CORNERS OF MAP
	POINTS(1,1)=(A(2)*IYI+A(3)*IZI+A(4))/IX
	POINTS(1,2)=(A(2)*IYF+A(3)*IZI+A(4))/IX
	POINTS(1,3)=(A(2)*IYI+A(3)*IZF+A(4))/IX
	POINTS(2,1)=FLOAT(IYI)/FLOAT(IY)
	POINTS(2,3)=POINTS(2,1)
	POINTS(3,1)=FLOAT(IZI)/FLOAT(IZ)
	POINTS(3,2)=POINTS(3,1)
	POINTS(2,2)=FLOAT(IYF)/FLOAT(IY)
	POINTS(3,3)=FLOAT(IZF)/FLOAT(IZ)
	WRITE(IOUT,8)POINTS
	IF(CELL(1).LE.0.0)GO TO 342
C        COMPUTE SIZE OF TRANSFORMED SECTION
	AA=0.0
	BB=0.0
	CC=0.0
	DO 340 I=1,3
	POINTS(I,2)=(POINTS(I,2)-POINTS(I,1))*CELL(I)
	AA=AA+POINTS(I,2)**2
	POINTS(I,3)=(POINTS(I,3)-POINTS(I,1))*CELL(I)
	BB=BB+POINTS(I,3)**2
  340 CC=CC+POINTS(I,2)*POINTS(I,3)
	DO 341 I=1,3
	J=MOD(I,3)+1
	K=9-I-J
	AA=AA+2.0*CELL(K)*POINTS(I,2)*POINTS(J,2)
	BB=BB+2.0*CELL(K)*POINTS(I,3)*POINTS(J,3)
  341 CC=CC+CELL(K)*(POINTS(I,2)*POINTS(J,3)+POINTS(J,2)*POINTS(I,3))
	AA=SQRT(AA)
	BB=SQRT(BB)
	CC=ACOS(CC/(AA*BB))*57.2957
	WRITE(IOUT,9)AA,BB,CC
C        COMPUTE SIZE OF SECTION
  342 NUM=JXA*JYA
	IZA=IZF-IZI+1
	IYA=IYF-IYI+1
	NUM2=IYA*IZA+NUM
	IF(MAXSIZ.LT.NUM2)STOP 'NOT ENOUGH MEMORY'
	DO 339 II=1,IZA
  339 JSECT(II)=1
	IFC=1
	IFCY=1
	IFCZ=1
C        CLEAR FLAGS IF FULL CELL AVAILABLE ALONG X, Y, AND Z
	IF(IXF-IXI.GE.IX-1)IFC=0
	IF(JYF-JYI.GE.IY-1)IFCY=0
	IF(JZF-JZI.GE.IZ-1)IFCZ=0
C        READ SECTION
   35 READ(ISC)(BUFF(I),I=1,NUM)
	DO 90 II=1,IZA
	JZC=II+IZI-1
	IZC=JZC
C        GET Z INTO ACTUAL SET COMPUTED
  343 IF(JZC.GE.JZI.AND.JZC.LE.JZF)GO TO 3 44
	IF(IFCZ.NE.0)GO TO 320
	JZC=JZC-ISIGN(IZ,JZC)
	GO TO 343
  344 IF(JZC.NE.KZC)GO TO 90
	JSECT(II)=0
	IYC=IYI
   40 IF(IYC.GT.IYF)GO TO 90
	JYC=IYC
C        GET Y INTO ACTUAL SET COMPUTED
   41 IF(JYC.GE.JYI.AND.JYC.LE.JYF)GO TO 42
	IF(IFCY.NE.0)GO TO 320
	JYC=JYC-ISIGN(IY,JYC)
	GO TO 41
   42 INDEX=NUM+(IZC-IZI)*IYA+IYC-IYI+1
	X=A(2)*IYC+A(3)*IZC+A(4)
	J=(JYC-JYI)*JXA-IXI+1
	I=X
	FX=X-I
	JDEX(1)=I-1
	JDEX(2)=I
	JDEX(3)=I+1
	JDEX(4)=I+2
	DO 60 I=1,4
   50 IF(JDEX(I).GE.IXI.AND.JDEX(I).LE.IXF)GO TO 60
	IF(IFC.NE.0)GO TO 70
	JDEX(I)=JDEX(I)-ISIGN(IX,JDEX(I))
	GO TO 50
   60 JDEX(I)=J+JDEX(I)
	AA=-ILINE(IP1)/6.+ILINE(IP2)/2.-ILINE(IP3)/2.+ILINE(IP4)/6.
	BB=ILINE(IP1)/2.-ILINE(IP2)+ILINE(IP3)/2.
	CC=-ILINE(IP1)/3.-ILINE(IP2)/2.+ILINE(IP3)-ILINE(IP4)/6.
	BUFF(INDEX)=((AA*FX+BB)*FX+CC)*FX+ILINE(IP2)
	GO TO 80
   70 BUFF(INDEX)=11111.
   80 IYC=IYC+1
	GO TO 40
   90 CONTINUE
C        CHECK IF ANY SECTIONS LEFT TO FIND
	DO 91 II=1,IZA
	IF(JSECT(II))30,91,30
   91 CONTINUE
  100 N=0
	DO 120 I=1,IYA,30
	N=N+1
	L=MIN0(30,IYA-I+1)
	J=I+IYI-1
	M=0
	DO 105 K=1,L,2
	M=M+1
  105 FY(M)=J+K-1
	WRITE(IOUT,4)TITLE,N,IZO,(FY(K),K=1,M)
	DO 120 J=1,IZA
	K=NUM+(J-1)*IYA+I
	KK=K+L-1
	DO 110 M=K,KK
  110 LINE(M-K+1)=BUFF(M)+SIGN(.5,BUFF(M))
	II=J+IZI-1
  120 WRITE(IOUT,14)FRMT(ISPC),II,(LINE(M),M=1,L)
	IF(IO.EQ.0)GO TO 15
	K=NUM+1
	L=1000
	WRITE(ISC1)IYA,IZA,IZO,L,IX,IXI,IXF,IY,IYI,IYF,IZI,IZF
	WRITE(ISC1)(BUFF(M),M=K,NUM2)
	GO TO 15
  900 STOP
	END
