FTN4
      SUBROUTINE NWFIL(LU1,IERR,IDCB,IDCBSZ,NAMR,JBLK,ITYPE,IABORT) 
     +,92069-16179 REV.2013 790316
C 
C 
C*****************************************************************
C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED.
C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR
C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR
C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. 
C****************************************************************** 
C 
C 
C     SOURCE:    92069-18179
C     RELOC:     92069-16179
C 
C 
C****************************************************************:
C 
C 
C*********************************************************************
C NWFIL CREATES A NEW FILE NAMED NAMR, OF SIZE ISIZE, AND TYPE ITYPE. 
C 
C IABORT = 'AB' TO RETURN NEGATIVE ERROR ON DUPLICATE FILE. 
C        = ANYTHING ELSE TO ATTEMPT PURGE OF DUPLICATE FILE BEFORE CREATE.
C 
C NAMR =
C 1)1ST TWO CHARACTERS OF NAMR
C 2)2ND TWO CHARS 
C 3)3RD TWO CHARS 
C 4)3 
C 5)SECURITY CODE 
C 6)CARTRIDGE NUMBER
C 
C BLK  = DOUBLE INTEGER SIZE OF THE NEW FILE ON DISC. 
C JBLK = DOUBLE INTEGER SIZE OF FILE REQUESTED BY CALLING PROGRAM,
C        AND DOUBLE INTEGER SIZE OF RECORD IN JBLK(3) AND JBLK(4).
C********************************************************************** 
C PARAMETER DECLARATIONS
C 
      INTEGER LU1,IERR,IDCB(1),IDCBSZ,NAMR(1),JBLK(1),ITYPE,IABORT
      REAL BLK
C     DOUBLE INTEGER BLK
C******************************************************************** 
C MAKE SURE ITS A NAMR PARAMETER, GET ISECU AND ICR 
C 
      IF (NAMR(4) .NE. 3) CALL DBER2(LU1,7777,NAMR,6HNWFIL ,2HAB) 
      ISECU=NAMR(5) 
      ICR=NAMR (6)
C****************************************************************** 
C SEE IF YOU SHOULD SKIP THE PURGE. 
C 
      IF (IABORT .EQ. 2HAB) GO TO 100 
      CALL PURGE(IDCB,IERR,NAMR,ISECU,ICR)
      IF (IERR .EQ. -6) GO TO 100 
      IF (IERR .LT. 0) GOTO 200 
C*****************************************************************
C CREATE THE NEW FILE WITH INFO PASSED IN.
C 
100   CALL ECREA(IDCB,IERR,NAMR,JBLK,ITYPE,ISECU,ICR,IDCBSZ,BLK)
      IF (IERR .GE. 0) IERR=0 
200   CALL DBER2(LU1,IERR,NAMR,6HNWFIL ,2HXX) 
      RETURN
      END 
                              