C++*********************************************************************
C
C  CSLICE.F                                FILE NAMES LENGTHENED AL
C                                   USED OPFILE NOV 00 ARDEAN LEITH
C
C **********************************************************************
C=*                                                                    *
C=* This file is part of:   SPIDER - Modular Image Processing System.  *
C=* SPIDER System Authors:  Joachim Frank & ArDean Leith               *
C=* Copyright 1985-2010  Health Research Inc.,                         *
C=* Riverview Center, 150 Broadway, Suite 560, Menands, NY 12204.      *
C=* Email: spider@wadsworth.org                                        *
C=*                                                                    *
C=* SPIDER is free software; you can redistribute it and/or            *
C=* modify it under the terms of the GNU General Public License as     *
C=* published by the Free Software Foundation; either version 2 of the *
C=* License, or (at your option) any later version.                    *
C=*                                                                    *
C=* SPIDER is distributed in the hope that it will be useful,          *
C=* but WITHOUT ANY WARRANTY; without even the implied warranty of     *
C=* merchantability or fitness for a particular purpose.  See the GNU  *
C=* General Public License for more details.                           *
C=* You should have received a copy of the GNU General Public License  *
C=* along with this program. If not, see <http://www.gnu.org/licenses> *
C=*                                                                    *
C **********************************************************************
C
C  CSLICE:     SELECT CENTRAL SLICE OF A 3-D IMAGE WITH ARBITRARY
C		        AZIMUTH AND INCLINATION.
C
C--*******************************************************************

	SUBROUTINE CSLICE

	INCLUDE 'CMBLOCK.INC'
	INCLUDE 'CMLIMIT.INC'

        COMMON /IOBUF/ A0(NBUFSIZ)
	COMMON BUF(1)
 
        CHARACTER(LEN=MAXNAM)   ::  FILNAM,FILOUT
        COMMON /COMMUN/ FILNAM,FILOUT
        
	DATA LUNI/17/,LUNO/16/,PI/3.14159/

        IERR  = 0

        MAXIM = 0
        CALL OPFILEC(0,.TRUE.,FILNAM,LUNI,'O',IFORM,NSAM,NROW,NSLICE,
     &                   MAXIM,'INPUT',.TRUE.,IRTFLG)
        IF (IRTFLG .NE. 0) RETURN

	IF (IFORM .NE. 3) THEN
           CALL ERRT(2,'CSLICE',NDUM)
           RETURN
        ENDIF

        FMININ = FMIN
	NROW3  = NROW*NSLICE
	S3     = SQRT(3.)
	MAXREC = NROW*NSLICE
	NSAM2  = NSAM*S3+0.5
	NROW2  = NROW*S3+0.5
	NSAMH  = NSAM2/2+1
	NROWH  = NROW2/2+1

        MAXIM  = 0
	IFORM  = 1
        CALL OPFILEC(0,.TRUE.,FILOUT,LUNO,'U',IFORM,NSAM2,NROW2,1,
     &                   MAXIM,'OUTPUT',.TRUE.,IRTFLG)
        IF (IRTFLG .NE. 0) GOTO 9000

	CALL RDPRM(PHI,NOT_USED,'AZIMUTH')
	CALL RDPRM(THETA,NOT_USED,'INCLINATION')

	PHI   = PHI*PI/180.
	THETA = THETA*PI/180.
C	KXM   = NSAM/2+1
C	KYM   = NROW/2+1
C	KZM   = NSLICE/2+1
	CALL RDPRMI(KXM,KYM,NOT_USED,'ENTER X,Y POSITION')
	CALL RDPRMI(KZM,NDUM,NOT_USED,'ENTER Z POSITION')
	SPHI  = SIN(PHI)
	CPHI  = COS(PHI)
	STHETA = SIN(THETA)
	CTHETA = COS(THETA)
	XFACT  = CTHETA*SPHI
	YFACT  = CTHETA*CPHI

C       DIMENSIONS OF 2-D FILE ARE NSAM2 BY NROW2
	DO IY=1,NROW2
           DO 200 IX=1,NSAM2
              X = KXM+((FLOAT(IX-NSAMH))*CPHI)+((FLOAT(IY-NROWH))*XFACT)
              Y = KYM-((FLOAT(IX-NSAMH))*SPHI)+((FLOAT(IY-NROWH))*YFACT)
              Z = KZM+(FLOAT(IY-NROWH))*STHETA

C             DETERMINE THE 8 SURROUNDING COEFFICIENTS
              KXBOT = X
              KXTOP = KXBOT+1
              XDEC = X-(FLOAT(KXBOT))
              XREM = 1.-XDEC

              KYBOT = Y
              KYTOP = KYBOT+1
              YDEC = Y-(FLOAT(KYBOT))
              YREM = 1.-YDEC

              KZBOT = Z
              KZTOP = KZBOT+1
              ZDEC = Z-(FLOAT(KZBOT))
              ZREM = 1.-ZDEC

C             CHECK IF COORDINATES ARE INSIDE THE VOLUME;  
C             CONTINUE IF THEY ARE, OTHERWISE, SET = 0.
              IF (KXTOP.LE.NSAM.AND.KYTOP.LE.NROW.AND.
     &           KZTOP.LE.NSLICE.AND.
     &           KXBOT.GE.1.AND.KYBOT.GE.1.AND.KZBOT.GE.1)GOTO 100
              BUF(IX) = FMININ
              GOTO 200


100           IREC1=(KZBOT-1)*NROW+KYBOT
              IF (IREC1.GT.MAXREC) IERR=7
              IF (IERR.NE.0) GOTO 8000

              CALL REDLIN(LUNI,A0,NSAM,IREC1)
              PT1 = A0(KXBOT)
              PT2 = A0(KXTOP)

              IREC2=(KZBOT-1)*NROW+KYTOP
              IF (IREC2.GT.MAXREC) IERR=7
              IF (IERR.NE.0) GOTO 8000
              CALL REDLIN(LUNI,A0,NSAM,IREC2)
              PT3 = A0(KXBOT)
              PT4 = A0(KXTOP)

              IREC3=(KZTOP-1)*NROW+KYBOT
              IF (IREC3.GT.MAXREC) IERR=7
              IF (IERR.NE.0) GOTO 8000
              CALL REDLIN(LUNI,A0,NSAM,IREC3)
              PT5 = A0(KXBOT)
              PT6 = A0(KXTOP)


              IREC4=(KZTOP-1)*NROW+KYTOP
              IF (IREC4.GT.MAXREC) IERR=7
              IF (IERR.NE.0) GOTO 8000
              CALL REDLIN(LUNI,A0,NSAM,IREC4)
              PT7 = A0(KXBOT)
              PT8 = A0(KXTOP)

C             WRITE(4,8888)PT1,PT2,PT3,PT4,PT5,PT6,PT7,PT8
C8888         FORMAT(' PTS 1-8 = ',8F7.3)

C             INTERPOLATE
	      BUF(IX) = ZREM*(XDEC*(YREM*PT2+YDEC*PT4)+
     &           XREM*(YREM*PT1+YDEC*PT3))+
     &           ZDEC*(XDEC*(YREM*PT6+YDEC*PT8)+
     &           XREM*(YREM*PT5+YDEC*PT7))


200	   CONTINUE
	   CALL WRTLIN(LUNO,BUF,NSAM2,IY)
	ENDDO
	GOTO 9000

8000	CALL ERRT(IERR,'CSLICE',NE)

9000	CLOSE(LUNO)
	CLOSE(LUNI)
        RETURN
	END