C++*********************************************************************
C
C              OPFILEC                             FEB  03 ARDEAN LEITH
C **********************************************************************
C=* FROM: SPIDER - MODULAR IMAGE PROCESSING SYSTEM.   AUTHOR: J.FRANK  *
C=* Copyright (C) 1985-2005  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  Shift alignment  07/31/91, non-power-of-two dimensions
C     Subtraction of an image from the average.
c     Quadratic interpolation as an option.
c     Scratch file on the disk
C
c  Procedures called:
C       SUBROUTINE  SAQB(MAXMEM)
C       SUBROUTINE  SAQB_P(BUF,NSAM,NROW,NIMA,NGRP,JACUP,
C       SUBROUTINE  SAQB_F(BUF,NSAM,NROW,NIMA,NGRP,JACUP,
C       SUBROUTINE  UPDTF(C,A,N,IMI)
C       SUBROUTINE  COP(A,B,N)
C       SUBROUTINE  CRSM_2(X,Y,O,NSAM,NROW,WRK)
C       SUBROUTINE   MLC(X,Y,O,N)
C       SUBROUTINE  SHFC_2(X,Y,NSAM,NROW,WRK,SX,SY)
C       SUBROUTINE  SH180_2(X,Y,NSAM,NROW,WRK,SX,SY)
C       SUBROUTINE  SHFM_2(X,NSAM,NROW,WRK,SX,SY)
C       SUBROUTINE  CR180_2(X,Y,O,NSAM,NROW,WRK)
C       SUBROUTINE   MJC(X,Y,O,N)
C       SUBROUTINE  FMR_2(X,NSAM,NROW,WORK,INV)
C       SUBROUTINE  FMR_1(X,N,WORK,INV)
C       SUBROUTINE  FFTMCF (A,B,NTOT,N,NSPAN,ISN)
C       SUBROUTINE  FINDMX(D,NSAM,NROW,CMX,SX,SY,JACUP)
C       DOUBLE PRECISION FUNCTION ENFR_2(A,NSAM,NROW)
C       SUBROUTINE  RTQ(X,OUT,NSAM,NROW,THETA)
C       FUNCTION QUADRI(XX, YY, NXDATA, NYDATA, FDATA)
C
C IMAGE_PROCESSING_ROUTINE
C
C        1         2         3         4         5         6         7
C23456789012345678901234567890123456789012345678901234567890123456789012
C--*********************************************************************

        SUBROUTINE SAQB

        INCLUDE 'CMBLOCK.INC'  
        COMMON  DUMMY(80),BUF(1024)

        CHARACTER*80  FINPAT,DOCFIL,FINPIC
        COMMON  /FISPEC/  FINPAT,NLET,FINPIC,DOCFIL,NLETI

        REAL, ALLOCATABLE, DIMENSION(:,:) :: CNEW
        CHARACTER*1  NULL,FLIP
        DATA  INPIC/77/,NDOC/55/

C       ASK FOR DATA FILE
        NULL=CHAR(0)

        CALL  FILERD(FINPAT,NLET,NULL,
     &          'ENTER TEMPLATE FOR 2-D IMAGE NAME',INTFLG)
        IF(INTFLG.NE.0) RETURN

        CALL  FILERD(DOCFIL,NLETI,NULL,
     &          'DOCUMENT (WITH GROUP ASSIGNMENT)',IRTFLG)
        IF (IRTFLG.EQ.-1)  RETURN

        CALL  RDPRMI(NGRP,NIMA,NOT_USED,'GROUP NUMBER')
        CALL  RDPRMC(FLIP,NA,.TRUE.,'CHECK 180 DEG POSITION (Y/N)',
     &      NULL,ITRFLG)

C       CALL  RDPRMI(JACUP,NDUMP,NOT_USED,
C     &          'PRECISION OF PEAK LOCATION (0..100)')
C       JACUP=MAX0(0,MIN0(100,JACUP))

        JACUP=0

        K=0
        K2=1
        NIMA=0
778     LERR=-1
        KP1=K+1
        CALL  UNSAV(DOCFIL,K,NDOC,KP1,BUF,4,LERR,K2)
        IF(LERR.EQ.0)  THEN
           IF(IFIX(BUF(4)).EQ.NGRP)  NIMA=NIMA+1
           K=K+1
C          PICK UP ONE OF THE IMAGES
           IMAGE=IFIX(BUF(1))
           GOTO  778
        ENDIF

        IF(NIMA.EQ.0)  THEN
           WRITE(NOUT,*)  ' *** DESIRED GROUP NOT FOUND !'
           CLOSE(NDOC)
           RETURN
        ENDIF

C       OPEN FIRST IMAGE FILE TO DETERMINE NSAM, NROW, NSL

        CALL FILGET(FINPAT,FINPIC,NLET,IMAGE,INTFLG)

        MAXIM = 0
        CALL OPFILEC(0,.FALSE.,FINPIC,INPIC,'O',IFORM,NSAM,NROW,NSL,
     &             MAXIM,'DUMMY',.FALSE.,IRTFLG)
        IF (IRTFLG .NE. 0) RETURN
        CLOSE(INPIC)

        LSD=NSAM+2-MOD(NSAM,2)

        ALLOCATE (CNEW(LSD,NROW), STAT=IRTFLG)
        IF (IRTFLG.NE.0) THEN 
           CALL ERRT(46,'AP SA, CNEW',IER)
           RETURN
        ENDIF

        IF (FLIP .EQ. 'Y')  THEN
           CALL  SAQB_P(BUF,LSD,NSAM,NROW,NIMA,NGRP,JACUP,CNEW)           
        ELSE
           CALL  SAQB_F(BUF,LSD,NSAM,NROW,NIMA,NGRP,JACUP,CNEW)     
        ENDIF

        MAXIM  = 0
        NSLICE = 1
        IFORM  = 1
        CALL OPFILEC(0,.TRUE.,FINPAT,INPIC,'U',IFORM,NSAM,NROW,NSLICE,
     &              MAXIM,'OUTPUT',.FALSE.,IRTFLG)
        IF (IRTFLG .NE. 0)  THEN
           CALL ERRT(4,'AP SA ',NE)
           DEALLOCATE (CNEW)
           RETURN
        ENDIF

        INS = -1
        CALL  FMRS_2(CNEW,NSAM,NROW,INS)

        CALL WRITEV(INPIC,CNEW,LSD,NROW,NSAM,NROW,NSLICE)

5       CLOSE(INPIC)
        WRITE (NDAT,2600) 

        CLOSE(NDOC)

        DEALLOCATE (CNEW)
        RETURN

2600    FORMAT (/' ',80('-')//' ',' Shift alignment,  ',
     &      'end of computation',//' ',80('-')/)

        END