C++*********************************************************************
C
C COPYD.F      CREATED                        23 DEC 87 ARDEAN LEITH
C              USED GETOLDSTACK, GETNEWSTACK  APRIL 99  ARDEAN LEITH
C              GETNEWSTACK PARAM.             FEB 03    ARDEAN LEITH
C              FLIPEND                        FEB 03    ARDEAN LEITH
C              MPI                            FEB 04    Chao Yang
C
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  COPYD(IRTFLG)
C
C  PURPOSE:  COPY A SPIDER IMAGE FILE TO ANOTHER FILE
C 
C  PARAMETERS:       IRTFLG       ERROR FLAG                      (RET.)
C
C  NOTES:   NEEDS TO SET BUF(26) IN STACK
C
C23456789 123456789 123456789 123456789 123456789 123456789 123456789 12
C--*********************************************************************

        SUBROUTINE COPYD(LUNIN,LUNOUT,INDXD,
     &                   NSAM,NROW,NSLICE,NSTACKIN,ITYPE,IFLIP)

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

        CHARACTER (LEN=MAXNAM) :: FILNAM
        COMMON /COMMUN/ FILNAM

        COMMON /IOERR/  IERR
        COMMON /IOBUF/  BUF(NBUFSIZ)

        LOGICAL :: VERBOSE_SAVE,INDXD
#ifdef USE_MPI
        include 'mpif.h'
        INTEGER  MYPID, COMM, MPIERR, NLETI
        CHARACTER(LEN=1) :: NULL
        COMM = MPI_COMM_WORLD
        MPIERR = 0 
        CALL MPI_COMM_RANK(COMM, MYPID, MPIERR)
        NULL = CHAR(0)
#else
        MYPID = -1
#endif

        VERBOSE_SAVE = VERBOSE

C	OPEN OUTPUT FILE, KEEP INPUT FILE DATE, TIME AND TITLE
        NSTACKOUT =  1           
        IF (NSTACKIN .GT. 0) THEN
C          INPUT IS A WHOLE STACK CHECK IF WANT INDEXED STACK
           IF (INDXD) NSTACKOUT = -NSTACKIN
        ENDIF

        CALL OPFILEC(LUNIN,.TRUE.,FILNAM,LUNOUT,'U',ITYPE,
     &               NSAM,NROW,NSLICE,NSTACKOUT,'OUTPUT',.TRUE.,IRTFLG) 
	IF (IRTFLG .NE. 0) RETURN
        IF (IFLIP .EQ. 1) CALL LUNSETFLIP(LUNOUT,IFLIP,IRTFLG)

	IF (NSTACKIN .GT. 0 .AND. NSTACKOUT .GE. 0) THEN
C	   DUPLICATE WHOLE STACK FILE RECORD BY RECORD INCLUDING HEADER

C          FIGURE OUT NUMBER OF DATA RECORDS TO BE COPIED
	   CALL TOTREC(NSAM,NROW,NSLICE,IEND)

C          DO NOT REPORT FILE INFO
           VERBOSE = .FALSE.

C          KEEP TRACK OF NUMBER OF IMAGES DONE
           IMDONE = 0

           IMGNUM = 1
           DO WHILE (IMGNUM .LE. NSTACKIN)

C            GET INPUT IMAGE FROM INPUT STACK (CAN INCREASE IMGNUM)            
             CALL GETOLDSTACK(LUNIN,NSAM,IMGNUM,
     &                       .TRUE.,.FALSE.,.TRUE.,IRTFLG)

             IF (IRTFLG .EQ. 0) THEN
C               CREATE OUTPUT IMAGE IN OUTPUT STACK
                CALL GETNEWSTACK(LUNIN,LUNOUT,NSAM,IMGNUM,IRTFLG)

                DO IREC = 1,IEND
                   CALL REDLIN(LUNIN,BUF,NSAM,IREC)
	           IF (IERR .NE. 0) THEN
                      WRITE(NOUT,*) 
     &                    '*** I/O ERROR:(',IERR,') READING RECORD: ',
     &                    IREC
                      CALL ERRT(101,'COPYD',IDUM)
                      GOTO 999
                   ENDIF

                   CALL WRTLIN(LUNOUT,BUF,NSAM,IREC)
	           IF (IERR .NE. 0) THEN
                      CALL ERRT(101,'COPYD',IDUM)
                      GOTO 999
                   ENDIF
                END DO
                IMGNUM = IMGNUM + 1
                IMDONE = IMDONE + 1
             ENDIF
           ENDDO

           IF (MYPID .LE. 0) WRITE(NOUT,90) IMDONE
90         FORMAT('  IMAGES COPIED: ',I6)
   
        ELSEIF (NSTACKIN .GE. 0 .AND. NSTACKOUT .LT. 0) THEN
           CALL ERRT(101,'CAN NOT COPY A WHOLE STACK TO AN IMAGE',NE)
           GOTO 999

	ELSE
C	  IMAGE TO STACKED IMAGE OR STACKED IMAGE TO IMAGE

C         ALTER NECESSARY HEADER VALUES SUCH AS: BUF=24 & 27

C         ISTACK (BUF=25)IS  -1 JUST FOR OLD WEB COMPATIBILITY
          IV25 = 0
          IF (NSTACKOUT .GT. -2) IV25 = -1

          CALL LUNSET25(LUNOUT,IV25,IRTFLG)

C         SET IMGNUM  (BUF=27)
          CALL LUNGETINUSE(LUNOUT,IMGNUM,IRTFLG)
          IF (NSTACKOUT .EQ. -2) IMGNUM = 0
          CALL LUNSETINUSE(LUNOUT,IMGNUM,IRTFLG)

C         PLACE ALTERED HEADER INTO NEW IMAGE FILE
	  CALL LUNWRTHED(LUNOUT,NSAM,IMGNUM,IRTFLG)
          IF (IRTFLG .NE. 0) GOTO 999
    
C         FIGURE OUT NUMBER OF DATA RECORDS TO BE COPIED
	  CALL TOTREC(NSAM,NROW,NSLICE,IEND)

C         COPY THE DESIRED NUMBER OF DATA RECORDS
          DO  I = 1,IEND
             CALL REDLIN(LUNIN,BUF,NSAM,I)
             CALL WRTLIN(LUNOUT,BUF,NSAM,I)
          ENDDO

       ENDIF
       IRTFLG = 0

999    CLOSE(LUNIN)
       CLOSE(LUNOUT)
       VERBOSE = VERBOSE_SAVE  

       RETURN
       END