C++*********************************************************************
C
C DSGRS.F           'AP RNS' FROM DSGR        APR 03 ARDEAN LEITH
C                   REWRITE                   AUG 03 ARDEAN LEITH
C                   APRINGS_NEW               APR 08 ARDEAN LEITH
C
C **********************************************************************
C=* FROM: SPIDER - MODULAR IMAGE PROCESSING SYSTEM.   AUTHOR: J.FRANK  *
C=* Copyright (C) 1985-2008  Health Research Inc.                      *
C=*                                                                    *
C=* HEALTH RESEARCH INCORPORATED (HRI),                                *   
C=* ONE UNIVERSITY PLACE, RENSSELAER, NY 12144-3455.                   *
C=*                                                                    *
C=* Email:  spider@wadsworth.org                                       *
C=*                                                                    *
C=* This program 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=* This program 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=*                                                                    *
C=* You should have received a copy of the GNU General Public License  *
C=* along with this program; if not, write to the                      *
C=* Free Software Foundation, Inc.,                                    *
C=* 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.      *
C=*                                                                    *
C **********************************************************************
C
C    DSGRS (ILIST,NIMA,ILIP,NIDI,
C             LSAM,LROW,NR,LENTT,
C             NRING,LCIRC,NUMR,BFC,BFC_IN_CORE,
C             MODE,SCRFILE,FFTW_PLANS,
C             REFPAT,FILNAM)
C
C    DISTANCES BETWEEN PROJECTIONS.
C    BUFFER ON THE DISK IN THE 'SCRATCH.FILE'
C    SWITCHES BETWEEN "IN CORE" AND "ON DISK" VERSION,
C    SCRATCH.FILE PRODUCED IN EITHER CASE ...
C    DO NOT CHECK MIRRORED ORIENTATIONS..
C    SIMILAR TO 'AP RN' BUT SINGLE EXP. IMAGE AND NO ANGULAR RESTRICTION
C
C--*********************************************************************

        SUBROUTINE DSGRS(ILIST,NIMA,ILIP,NIDI,
     &             LSAM,LROW,NR,LENTT,
     &             NRING,LCIRC,NUMR,BFC,BFC_IN_CORE,
     &             MODE,SCRFILE,FFTW_PLANS,
     &             REFPAT,FILNAM)

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

	INTEGER,DIMENSION(NIDI)                     :: ILIP 
	INTEGER,DIMENSION(NIMA)                     :: ILIST 
        INTEGER,DIMENSION(3,NRING)                  :: NUMR
	REAL, DIMENSION(LCIRC,NIMA)                 :: BFC
	CHARACTER(LEN=1)                            :: MODE 
	CHARACTER (LEN=*)                           :: SCRFILE
        CHARACTER (LEN=*)                           :: REFPAT
        CHARACTER (LEN=*)                           :: FILNAM

	REAL,DIMENSION(3)                           :: DLIST 
	REAL, ALLOCATABLE, DIMENSION(:,:)           :: X 
 	DOUBLE PRECISION                            :: EAV
	CHARACTER(LEN=1)                            :: NULL
	LOGICAL                                     :: BFC_IN_CORE
        INTEGER *8                                  :: FFTW_PLANS(*)

C       AUTOMATIC ARRAYS
        REAL, DIMENSION(3)                          :: TA
	DOUBLE PRECISION, DIMENSION(LENTT)          :: TT
 	DOUBLE PRECISION, DIMENSION(NIMA)           :: TOTMIN 
 	REAL, DIMENSION(NIMA)                       :: TOT 
 	REAL, DIMENSION(LCIRC)                      :: CIROLD,CIRC 
        REAL, DIMENSION(LSAM)                       :: BUFIN

	DATA  INPIC/77/,INANG/78/,NDOC/55/,NSCF/50/

        NULL = CHAR(0)

        MAXRIN = NUMR(3,NRING)

	CALL  APMASTER_1(MODE,DIVAS,NR,NUMTH,LSAM,LROW,NSAM,NROW,
     &                   TT,LENTT)

        ALLOCATE(X(NSAM,NROW),STAT=IRTFLG)
	IF (IRTFLG .NE. 0) THEN
           MWANT = NSAM * NROW 
           CALL  ERRT(46,'X',MWANT)
           GOTO 9999
        ENDIF

        LQ  = LROW/2+1
        LR1 = (NROW-1)/2
        LR2 = LQ+LR1
        LR1 = LQ-LR1
        LQ  = LSAM/2+1
        LS1 = (NSAM-1)/2
        LS2 = LQ+LS1
        LS1 = LQ-LS1

#ifdef SP_MP
        IF (.NOT. BFC_IN_CORE) THEN
           WRITE(NOUT,*) ' SETTING OMP THREADS: 2'
           CALL SETTHREADS(2)
  	ENDIF
#endif

C       READ REFERENCE IMAGES INTO REFERENCE RINGS (BFC) ARRAY 
        CALL APRINGS_NEW(ILIST,NIMA, LSAM,LROW,
     &               NRING,LCIRC,NUMR,MODE, FFTW_PLANS,
     &               REFPAT,INPIC,BFC,BFC_IN_CORE,
     &               NSCF,SCRFILE,IRTFLG)
       
        CALL AP_GETDAT(ILIP,NIDI, LSAM,LROW, NSAM,NROW,
     &                    1,FILNAM,INPIC, 1,1,
     &                    LR1,LR2,LS1,LS2, X, IRTFLG)
        IF (IRTFLG .NE. 0) GOTO 9999


C       CALCULATE DIMENSIONS FOR APRINGS
        CNS2 = NSAM / 2 + 1
        CNR2 = NROW / 2 + 1

C       EXTRACT EXP. IMAGE POLAR COORD. RINGS, NORMALIZE & FFT THEM
        CALL APRINGS_ONE_NEW(NSAM,NROW,  CNS2,CNR2, X,.TRUE.,
     &                         MODE,NUMR,NRING,LCIRC, 0.0,FFTW_PLANS,
     &                         CIROLD,IRTFLG)
        IF (IRTFLG .NE. 0) GOTO 9999

        EAV = -1.0D20
        IF (BFC_IN_CORE)  THEN
c$omp       parallel do private(imi)
            DO IMI = 1,NIMA
	      CALL CROSRNG_EP_NEW(BFC(1,IMI),CIROLD,LCIRC,NRING,
     &		            MAXRIN,NUMR, TOTMIN(IMI),TOT(IMI),
     &                      TT,.FALSE.,
     &                      FFTW_PLANS(1))
            ENDDO
        ELSE
            REWIND(NSCF)
            DO IMI = 1,NIMA
               READ(NSCF)  CIRC
	       CALL CROSRNG_EP_NEW(CIRC,CIROLD,LCIRC,NRING,
     &		            MAXRIN,NUMR, TOTMIN(IMI),TOT(IMI),
     &                      TT,.FALSE.,
     &                      FFTW_PLANS(1))
	    ENDDO
        ENDIF

C       FIND CLOSEST REF. IMAGE
        DO IMI=1,NIMA
           IF (VERBOSE) THEN
              RTT = (TOT(IMI)- 1) / MAXRIN * DIVAS
              WRITE(NOUT,98) ILIST(IMI), TOTMIN(IMI), RTT
98            FORMAT('  Reference #: ',I6,'  CC: ',1PG11.4,
     &               '  Best angle: ',1PG11.3)
           ENDIF
           IF (TOTMIN(IMI) .GE. EAV)  THEN
              EAV  = TOTMIN(IMI)
              IDI  = ILIST(IMI)
              RANG = TOT(IMI)
	   ENDIF
        ENDDO

C       MATCHING REFERENCE IMAGE NUMBER
        DLIST(1) = IDI

C       CC FOR MATCHING REF. IMAGE
        DLIST(2) = EAV

C       INPLANE ROTATION ANGLE
        RANG     = (RANG-1) / MAXRIN * DIVAS
        DLIST(3) = RANG

        CALL REG_GET_USED(NSEL_USED)
        IF (NSEL_USED .GT. 0) THEN
C           OUTPUT TO REGISTER NOT TO DOC FILE
            CALL REG_SET_NSEL(1,3,DLIST(1),DLIST(2),
     &             DLIST(3),0.0,0.0,IRTFLG)
         ENDIF

9999  IF (.NOT. BFC_IN_CORE) CLOSE(NSCF)

      IF (ALLOCATED(X))     DEALLOCATE(X)
 
      END