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                  OPFILEC                         FEB  03 ARDEAN LEITH

        SUBROUTINE TO_POLAR

        INCLUDE 'CMBLOCK.INC'
        INCLUDE 'CMLIMIT.INC' 
 
        CHARACTER(LEN=MAXNAM)   :: FINPIC,FINPAT
        COMMON  /F_SPEC/  FINPAT,NLET,FINPIC

        REAL, ALLOCATABLE, DIMENSION(:,:) :: X
        REAL, ALLOCATABLE, DIMENSION(:)   :: OUT
        CHARACTER(LEN=1)                  :: MODE,ASK,NULL

        DATA  INPIC/77/,INREF/76/

        NULL = CHAR(0)

C       ASK FOR DATA FILES
        MAXIM = 0
        CALL OPFILEC(0,.TRUE.,FINPIC,INPIC,'O',ITYPE,NSAM,NROW,
     &              NSLICE,MAXIM,'INPUT',.FALSE.,IRTFLG)
        IF (IRTFLG .NE. 0) RETURN

        CALL FILERD(FINPIC,NLET,NULL,'OUTPUT',IRTFLG)

        CALL  RDPRMI(MR,NR,NOT_USED,'INNER and OUTER RADIUS')
 
        ITEMP = MIN0(((NSAM-1)/2)*2+1,((NROW-1)/2)*2+1)
        IF (MR .LE .0 .OR. NR .GE. ITEMP) THEN
           CALL ERRT(31,'OR 2',NE)
           RETURN
        ENDIF

	ISKIP = 1
        NA    = 1
        CALL  RDPRMC(ASK,NA,.TRUE.,'(F)ULL OR (H)ALF CIRCLE',NULL,IRT)
        IF (ASK.EQ.'H')  THEN
           MODE = 'H'
        ELSE
           MODE = 'F'
        ENDIF

	PI    = 4*DATAN(1.0D0)
	NSAMP = INT(2*PI*NR)
	IF (ASK .EQ. 'H')  NSAMP=NSAMP/2
	NROWP = NR-MR+1

C       OPEN OUTPUT FILE
        MAXIM = 0
	ITYPE = 1
        CALL OPFILEC(0,.FALSE.,FINPIC,INREF,'N',ITYPE,NSAMP,NROWP,
     &              NSLICE,MAXIM,'POLAR',.FALSE.,IRTFLG)
        IF (IRTFLG .NE. 0) RETURN

C       FIND TOTAL NUMBER OF RINGS
        ALLOCATE (X(NSAM,NROW),OUT(NSAMP), STAT=IRTFLG)
        IF (IRTFLG.NE.0) THEN 
           CALL ERRT(46,'ORMD, X, OUT',IER)
           CLOSE(INPIC)
           CLOSE(INREF)
           RETURN
        ENDIF

	DO J=1,NROW
	  CALL REDLIN(INPIC,X(1,J),NSAM,J)
	ENDDO
	IXC = NSAM/2+1
	IYC = NROW/2+1
	IF (ASK.EQ.'F')  THEN
	   DFI=2*PI/NSAMP
	ELSE
	   DFI=PI/NSAMP
	ENDIF
	DO  J=MR,NR
	  DO I=1,NSAMP
	     FI=(I-1)*DFI
	     XS=COS(FI)*J
	     YS=SIN(FI)*J
	     OUT(I)=QUADRI(XS+IXC,YS+IYC,NSAM,NROW,X)*SQRT(REAL(J))
	  ENDDO
	  CALL  WRTLIN(INREF,OUT,NSAMP,J-MR+1)
	ENDDO

        CLOSE(INPIC)
        CLOSE(INREF) 
 
        DEALLOCATE (OUT)
        DEALLOCATE (X)
        END