*
* $Id: kaxwrt.F,v 1.1.1.1 1996/03/08 11:40:53 mclareni Exp $
*
* $Log: kaxwrt.F,v $
* Revision 1.1.1.1  1996/03/08 11:40:53  mclareni
* Kapack
*
*
#include "kapack/pilot.h"
      SUBROUTINE KAXWRT(NBLOCK,IBUFF,NWORDS)
*
*.....WRITE A SPECIFIED BLOCK
*
*.....DETECTION OF ILLEGAL FREE BLOCK POINTER ADDED 880628
*
#include "kapack/kax000.inc"
#include "kapack/kax020.inc"
#include "kapack/kax050.inc"
*
      INTEGER IBUFF(NWORDS)
*
*-----------------------------------------------------------------------
*
      IF ( NBLOCK.LT.1 .OR. NBLOCK.GT.NBLKS )  GO TO 91
      IF ( NWORDS.LT.1 .OR. NWORDS.GT.LBLK  )  GO TO 92
      IF(IBUFF(2).EQ.0.AND.IBUFF(3).EQ.1) GO TO 95
      IF ( IBUFF(1) .NE. NBLOCK )  GO TO 93
*
      WRITE(LUNKAF,ERR=94,IOSTAT=IOS,REC=NBLOCK) IBUFF
      IF ( IOS .NE. 0 )  GO TO 94
*
*.....SUCCESSFUL COMPLETION
      RETURN
*
*.....ERROR PROCESSING
 91   WRITE(MSG,191) NBLOCK, LUNKAF, NBLKS
      GO TO 99
*
 92   WRITE(MSG,192) NWORDS, LUNKAF, LBLK
      GO TO 99
*
 93   WRITE(MSG,193) LUNKAF, NBLOCK, IBUFF(1)
      GO TO 99
*
 94   WRITE(MSG,194) NBLOCK, LUNKAF, IOS
      GO TO 99
*
 95   WRITE(MSG,195) LUNKAF, NBLOCK, IBUFF(1),IBUFF(2),IBUFF(3),IBUFF(4)
      GO TO 99
*
 99   CALL KAXMSG(LUNERR,MSG)
      CALL KAXEND
*
 191  FORMAT('CRNKA271 KAXWRT: KAPACK SYSTEM ERROR OR CORRUPT FILE,
     +        REQUEST TO WRITE BLOCK ',I11,' TO UNIT ',I3,
     +       ' WHICH HAS ',I11,' BLOCKS')
 192  FORMAT('CRNKA272 KAXWRT: REQUEST TO WRITE ',I11,' WORDS TO
     +        UNIT ',I3,' WHICH HAS A BLOCK LENGTH OF ',I11,' WORDS')
 193  FORMAT('CRNKA273 KAXWRT: INVALID BLOCK NUMBER OR IDENTIFIER ON
     +        UNIT ',I3,', NUMBER = ',I11,', IDENTIFIER = ',I11)
 194  FORMAT('CRNKA274 KAXWRT: I/O ERROR WHILE WRITING BLOCK ',I11,
     +       ' TO UNIT ',I3,', IOSTAT = ',I11)
 195  FORMAT('CRNKA275 KAXWRT: KAPACK SYSTEM ERROR, ',
     +        'REQUEST TO WRITE BLOCK ',I11,' TO UNIT ',I3,
     +       ' WITH ILLEGAL FREE BLOCK POINTERS=',4I6)
*
      END