C++*********************************************************************
C
C    COPYF.FOR -- CREATED JULY 17 1989 ardean leith                     
C                 USED OPAUXFILE                  FEB 99 ARDEAN LEITH
C                 OPFILEC                         FEB 03 ARDEAN LEITH
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    COPYF(LUN1,LUN2)
C
C    PURPOSE:   COPIES AN EDITABLE TXT FILE INTO A SPIDER IMAGE FILE
C
C    PARAMETERS:   LUN1      INPUT FILE UNIT NUMBER
C                  LUN2      OUTPUT FILE UNIT NUMBER
C--*********************************************************************

	SUBROUTINE COPYF(LUN1,LUN2)

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

        COMMON /IOBUF/ BUF(NBUFSIZ)

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

        CHARACTER * 1   NULL,ANSW

        NULL = CHAR(0)

C       OPEN INPUT FILE AS SEQUENTIAL ACCESS, FORMATTED
10      LENREC = 0
        CALL OPAUXFILE(.TRUE.,FILNAM,DATEXC,LUN1,LENREC,'O',
     &                       'EDITABLE IMAGE INPUT',.TRUE.,IRTFLG)
        IF (IRTFLG .NE. 0) RETURN

12      CALL RDPRMC(ANSW,NC,.TRUE.,
     &     'ARE NSAM, NROW, & NSLICE IN FIRST LINE OF FILE? (Y/N)',
     &     NULL,IRTFLG)
        IF (IRTFLG .EQ. -1)  GOTO 10

        IF (NC .EQ. 0 .OR. ANSW .NE. 'N') THEN
C          CAN GET NSAM OUT OF FILE
           READ(LUN1,*,IOSTAT=IOS) NSAM,NROW,NSLICE
           IF (IOS .NE. 0) THEN
             CALL ERRT(101,'*** ERROR READING FILE',NDUM)
             GOTO 9999
           ENDIF

        ELSE
C          ASK USER FOR NSAM, ETC.
           CALL RDPRI3S(NSAM,NROW,NSLICE,NOT_USED,
     &                'ENTER NSAM, NROW & NSLICE',IRTFLG)
           IF (IRTFLG .EQ. -1) GOTO 12
        ENDIF

        IF (NSLICE .LE. 0) NSLICE = 1

16      CALL RDPRMC(FMT,NC,.TRUE.,
     &     'ENTER FORMAT DESCRIPTION (OR <CR> FOR FREE FORMAT)',
     &     NULL,IRTFLG)
        IF (IRTFLG .EQ. -1) GOTO 12

C       DEFAULT IS FREE FORMAT
        IF (NC .EQ. 0) FMT(1:60) = '(*)'

20      IFORM = 1
        IF (NSLICE .GT. 1) IFORM = 3
        MAXIM = 0
        CALL OPFILEC(0,.TRUE.,FILNAM,LUN2,'U',IFORM,NSAM,NROW,NSLICE,
     &             MAXIM,'OUTPUT',.FALSE.,IRTFLG)
        IF (IRTFLG .EQ. -1) GOTO 16
        IF (IRTFLG .NE. 0) GOTO 9999

	DO I=1,NROW * NSLICE
C          IOSTAT NEEDED FOR PARTIAL LINES
           READ(LUN1,FMT,IOSTAT=IOS) (BUF(J),J=1,NSAM)
           CALL WRTLIN(LUN2,BUF,NSAM,I)
        ENDDO

9999	CLOSE(LUN1)
	CLOSE(LUN2)

	RETURN

        END