*
* $Id$
*
* $Log$
* Revision 1.1  1996/03/08 11:40:50  mclareni
* Initial revision
*
*
#include "kapack/pilot.h"
      SUBROUTINE KACOPY(LUNIN,LUNOUT,MODE,IRC)
*
*.....COPY, LOAD, UNLOAD OR EXTEND A KA-FILE
*
#include "kapack/kax000.inc"
#include "kapack/kax020.inc"
#include "kapack/kax030.inc"
#include "kapack/kax050.inc"
#include "kapack/kax0a0.inc"
*
#if defined(CERNLIB_CRAY)
      CHARACTER*2 CHALUN
#endif
      INTEGER IFREE(1:4)
*
*-----------------------------------------------------------------------
*
      CALL KAXINN(LUNIN)
*
*.....CHECK THE ARGUMENTS
      IF ( LUNOUT.LT.1 .OR. LUNOUT.GT.MAXLUN )  GO TO 11
      IF ( MODE.LT.1 .OR.
     +    (MODE.GT.3.AND.MODE.LT.10) .OR.
     +     MODE.GT.1000 )  GO TO 12
*
*.....OPEN THE INPUT FILE AND READ THE FIRST BLOCK
      NBLOCK = 1
      IF ( MODE .EQ. 2 )  THEN
         REWIND LUNIN
         READ(LUNIN,ERR=91,IOSTAT=IOS)  (IA(I),I=1,15),
     +                                  (IA(J),J=16,IA(15))
         IF ( IOS .NE. 0 )  GO TO 91
      ELSE
         CALL KAXINI(LUNIN)
         CALL KAXRD(NBLOCK,IA,LBLK)
      ENDIF
      NXFREE = IA( 3)
      NB     = IA(14)
      LBKIN  = IA(15)
*
*.....OPEN THE OUTPUT FILE
      IF ( MODE .EQ. 1 )  THEN
         REWIND LUNOUT
      ELSE IF ( LBKS(LUNOUT) .EQ. 0 )  THEN
#if defined(CERNLIB_UNIX)
         WRITE(MSG,1000) LUNOUT
 1000    FORMAT('CRNKA28A KAMAKE: ENTER THE NAME OF THE KA-FILE FOR',
     +          ' UNIT ',I3)
         CALL KAXMSG(ISYSWR,MSG)
         READ(ISYSRD,1001) MSG
 1001    FORMAT(A)
#endif
#if defined(CERNLIB_CRAY)
         WRITE(CHALUN,'(I2)') LUNOUT
         MSG = 'fort.'//CHALUN(INDEX(CHALUN,' ')+1:2)
#endif
#if !defined(CERNLIB_NORD)
         OPEN  ( ACCESS = 'DIRECT',
#endif
#if defined(CERNLIB_NORD)
         OPEN  ( BUFFER_SIZE = LWORD * LBKIN,
     +           MODE        = 'SEGMENT',
#endif
#if defined(CERNLIB_UNIX)||defined(CERNLIB_CRAY)
     +           FILE   =  MSG(1:INDEX(MSG,' ')-1),
#endif
     +           ERR    =  92,
     +           FORM   = 'UNFORMATTED',
     +           IOSTAT =  IOS,
     +           RECL   =  LWORD*LBKIN,
#if defined(CERNLIB_VAX)
     +           STATUS =  'UNKNOWN',
#endif
#if defined(CERNLIB_CRAY)
     +           STATUS =  'NEW',
#endif
     +           UNIT   =  LUNOUT )
         IF ( IOS .NE. 0 )  GO TO 92
         LBKS(LUNOUT) = -1
      ELSE
         GO TO 93
      ENDIF
*
*.....WRITE THE FIRST BLOCK
      IF ( MODE .EQ. 1 )  THEN
         WRITE(LUNOUT,ERR=94,IOSTAT=IOS)  (IA(I),I=1,LBKIN)
         IF ( IOS .NE. 0 )  GO TO 94
      ELSE
         WRITE(LUNOUT,ERR=94,IOSTAT=IOS,REC=NBLOCK)  (IA(I),I=1,LBKIN)
         IF ( IOS .NE. 0 )  GO TO 94
      ENDIF
*
*.....COPY THE REMAINING BLOCKS
      DO  1  NBLOCK = 2, NB
         IF ( MODE .EQ. 2 )  THEN
            READ(LUNIN,END=96,ERR=91,IOSTAT=IOS)  (IA(I),I=1,LBKIN)
            IF ( IOS .NE. 0 )  GO TO 91
         ELSE
            CALL KAXRD(NBLOCK,IA,LBKIN)
         ENDIF
         IF ( IA(1) .NE. NBLOCK )  GO TO 95
         IF ( MODE .EQ. 1 )  THEN
            WRITE(LUNOUT,ERR=94,IOSTAT=IOS)  (IA(I),I=1,LBKIN)
            IF ( IOS .NE. 0 )  GO TO 94
         ELSE
            WRITE(LUNOUT,ERR=94,IOSTAT=IOS,REC=NBLOCK) (IA(I),I=1,LBKIN)
            IF ( IOS .NE. 0 )  GO TO 94
         ENDIF
 1    CONTINUE
*
*.....CHAIN THE NEW FREE BLOCKS IF EXPANSION HAS BEEN REQUESTED
      IF ( MODE .LT. 10 )  THEN
         NEW = 0
         NXFREE= IA(3)
      ELSE
         NEW      = NINT(REAL(NB)*REAL(MODE)/100.0)
         IFREE(2) = 0
         IFREE(3) = NXFREE
         IFREE(4) = 0
         DO  2  NBLOCK = NB+NEW, NB+1, -1
            IFREE(1) = NBLOCK
            WRITE(LUNOUT,ERR=94,IOSTAT=IOS,REC=NBLOCK) IFREE
            IF ( IOS .NE. 0 )  GO TO 94
            IFREE(3) = NBLOCK
 2       CONTINUE
         CALL KAXRD(1,IA,LBKIN)
         IA( 2) = IA( 2) + NEW
         IA( 3) = IFREE(1)
         IA(14) = NB + NEW
         WRITE(LUNOUT,ERR=94,IOSTAT=IOS,REC=1) (IA(I),I=1,LBKIN)
         IF ( IOS .NE. 0 )  GO TO 94
      ENDIF
*
*.....VERIFY THAT THE LAST BLOCK WAS WRITTEN CORRECTLY IF MODE>1
      IF ( MODE .GT. 1 )  THEN
         IA(1) = -1
         IA(3) = -1
         READ(LUNOUT,ERR=97,IOSTAT=IOS,REC=NB+NEW) ( IA(I), I=1,3 )
         IF ( IOS .NE. 0 )  GO TO 97
         IF ( IA(1).NE.NB+NEW .OR. IA(3).NE.NXFREE )  GO TO 97
      ENDIF
*
*.....SUCCESSFUL COMPLETION
      IRC = 0
      IF ( MODE .EQ. 1 )  WRITE(MSG,101) NB, LUNIN, LUNOUT
      IF ( MODE .EQ. 2 )  WRITE(MSG,102) NB, LUNIN, LUNOUT
      IF ( MODE .EQ. 3 )  WRITE(MSG,103) NB, LUNIN, LUNOUT
      IF ( MODE .GE. 10)  WRITE(MSG,110) NB, LUNIN, LUNOUT, NEW, MODE
      CALL KAXMSG(LUNLOG,MSG)
      RETURN
*
*.....ERROR PROCESSING
 11   IRC = 1
      WRITE(MSG,111) LUNOUT, MAXLUN
      GO TO 99
*
 12   IRC = 1
      WRITE(MSG,112) MODE
      GO TO 99
*
 91   WRITE(MSG,191) NBLOCK, LUNIN, IOS
      CALL KAXMSG(LUNERR,MSG)
      CALL KAXEND
*
 92   WRITE(MSG,192) LUNOUT, IOS
      CALL KAXMSG(LUNERR,MSG)
      CALL KAXEND
*
 93   WRITE(MSG,193) LUNOUT
      CALL KAXMSG(LUNERR,MSG)
      CALL KAXEND
*
 94   WRITE(MSG,194) NBLOCK, LUNOUT, IOS
      CALL KAXMSG(LUNERR,MSG)
      CALL KAXEND
*
 95   WRITE(MSG,195) LUNIN, NBLOCK, IA(1)
      CALL KAXMSG(LUNERR,MSG)
      CALL KAXEND
*
 96   WRITE(MSG,196) LUNIN, NBLOCK, NB, IOS
      CALL KAXMSG(LUNERR,MSG)
      CALL KAXEND
*
 97   WRITE(MSG,197) LUNOUT, IOS
      CALL KAXMSG(LUNERR,MSG)
      CALL KAXEND
*
 99   CALL KAXMSG(LUNERR,MSG)
      IF ( RETURN )  RETURN
      CALL KAXEND
*
 101  FORMAT('CRNKA280 KACOPY: ',I11,
     +       ' BLOCKS SUCCESSFULLY UNLOADED FROM THE KA-FILE ON UNIT ',
     +        I3,' TO THE SEQUENTIAL FILE ON UNIT ',I3)
 102  FORMAT('CRNKA280 KACOPY: ',I11,' BLOCKS SUCCESSFULLY LOADED ',
     +       ' FROM THE SEQUENTIAL FILE ON UNIT ',I3,
     +       ' TO THE KA-FILE ON UNIT ',I3)
 103  FORMAT('CRNKA280 KACOPY: ',I11,
     +       ' BLOCKS SUCCESSFULLY COPIED FROM THE KA-FILE ON UNIT ',I3,
     +       ' TO THE KA-FILE ON UNIT ',I3)
 110  FORMAT('CRNKA280 KACOPY: ',I11,
     +       ' BLOCKS SUCCESSFULLY COPIED FROM THE KA-FILE ON UNIT ',I3,
     +       ' TO THE KA-FILE ON UNIT ',I3,' WITH THE ADDITION OF ',I11,
     +       ' (',I11,'%) NEW BLOCKS')
 111  FORMAT('CRNKA281 KACOPY: ',I11,' IS NOT AN ACCEPTABLE UNIT NUMBER
     +        FOR THE OUTPUT FILE, IT MUST BE IN THE RANGE 1 - ',I3)
 112  FORMAT('CRNKA282 KACOPY: ',I11,' IS NOT AN ACCEPTABLE MODE, IT
     +        MUST BE IN THE RANGE 1-3 OR 10-1000')
 191  FORMAT('CRNKA283 KACOPY: I/O ERROR WHILE READING BLOCK ',I11,
     +       ' FROM UNIT ',I3,', IOSTAT = ',I11)
 192  FORMAT('CRNKA284 KACOPY: ERROR WHILE OPENING THE FILE ON UNIT ',
     +        I3,', IOSTAT = ',I11)
 193  FORMAT('CRNKA285 KACOPY: ATTEMPT TO OVERWRITE AN EXISTING KA-FILE
     +        ON UNIT ',I3)
 194  FORMAT('CRNKA286 KACOPY: I/O ERROR WHILE WRITING BLOCK ',I11,
     +       ' TO UNIT ',I3,', IOSTAT = ',I11)
 195  FORMAT('CRNKA287 KACOPY: INVALID BLOCK NUMBER OR IDENTIFIER ON
     +        UNIT ',I3,', NUMBER = ',I11,', IDENTIFIER = ',I11)
 196  FORMAT('CRNKA288 KACOPY: EOF ENCOUNTERED ON UNIT ',I3,
     +       ' WHILE READING BLOCK ',I11,
     +       ' FROM THE KA-FILE WHICH SHOULD CONTAIN ',I11,' BLOCKS, ',
     +       ' IOSTAT = ',I11)
 197  FORMAT('CRNKA289 KACOPY: ERROR(S) OCCURRED DURING CREATION OF THE
     +        NEW KA-FILE ON UNIT ',I3,', IOSTAT = ',I11)
*
      END
