SUBROUTINE GETNEWFIL(IIN,IGFG,ITRIAN,ISWT)

      INCLUDE 'BFILES.I90'

!   WRITE CURRENT DATA TO A SCRATCH FILE

      
      IF(IACTVFIL .GT. 0  .AND.  ISWT .NE. -1) THEN 
        IFILOUT=IACTVFIL+50
        WRITE(90,*) 'INGETNEWFIL IFILOUT',IFILOUT
        CALL WRTFIL(IFILOUT)
        CALL ZEROOUT
        IACTVFIL=ITOTFIL
      ELSEIF(IACTVFIL .EQ. 0) THEN
        IACTVFIL=1
      ENDIF
      IF(ISWT .EQ. 1) THEN
        ITOTFIL=ITOTFIL+1
        FNAMKEP='TEST.1.ELE'
        IACTVFIL=ITOTFIL
        FNAMEOUT(IACTVFIL)='TEST.1.ELE'
        WRITE(90,*) 'ITOTFIL,IACTVFIL',ITOTFIL,IACTVFIL
        WRITE(90,'(A80)') (FNAMEOUT(KKK),KKK=1,3)
      ELSE
        FNAMKEP='TEST.1.ELE'
      ENDIF
      IF(ABS(ITRIAN) .EQ. 1) THEN
        CALL READGFG(IIN,ITRIAN)

!   TEST FOR GFG FORMAT 
      ELSEIF(IGFG .EQ. 1) THEN
        CALL READGFG(IIN,0)

!   TEST FOR rm1 FORMAT

      ELSEIF(IIN .EQ. 10) THEN
        CALL READRM1(IIN)

!   TEST FOR rm1 FORMAT

!ipk feb08 replace iin of 11 with 12
      ELSEIF(IIN .EQ. 12  .and.  IGFG .EQ. 0) THEN
        CALL READGEO(IIN)

      ELSEIF(IIN .EQ. 12  .and.  IGFG .EQ. 2) THEN
        CALL RDBIN(IIN)

      ENDIF
      IF(ITRIAN .EQ. -1) RETURN
      
      IFILOUT=IACTVFIL+50
      WRITE(90,*) 'IFILOUT', IFILOUT
      CALL WRTFIL(IFILOUT)
      IACTVFIL=1
      CALL LOADFIL

      
      CALL RESCAL      
	  CALL HEDR


      RETURN
      END

!       Write data to a file 
      SUBROUTINE WRTFIL(IFILOUT)

      USE BLK1MOD
      CHARACTER*80 ALINE 
      CHARACTER*10 FMT
!      INCLUDE 'BLK1.COM'

      CLOSE (IFILOUT)
      FMT(1:8)='TEMPFIL.'
      WRITE(FMT(9:10),'(I2)') IFILOUT 
!      OPEN(IFILOUT,STATUS='scratch',FORM='binary')
      WRITE(90,*) 'IFILOUT',IFILOUT
!      OPEN(IFILOUT,STATUS='scratch',FORM='unformatted')
      OPEN(IFILOUT,FILE=FMT,STATUS='UNKNOWN',FORM='BINARY')

      ISLP=0
      IPRT=1 
      IPNN=1 
      IPEN=1 
      IPO=1 
      IRO=1 
      IPP=0 
      IRFN=0 
      IGEN=0 
      NXZL=0 
      NITST=1 
      ISCTXT=0 
      IFILL=0 
      IALTGM=1 
      NLAYD=0 
      HORIZ=10. 
      VERT=8. 
      XSALE=0. 
      YSALE=0. 
      XFACT=0. 
      YFACT=0. 
      AR=0. 
      ANG=0. 
      xadded=0.
      yadded=0.
      ntempin=0.
	  WRITE(90,*) 'IN WRTFIL',  IFILOUT,NP,NE,IPRT 
      WRITE(IFILOUT) TITLE,NP,NE 
      WRITE(IFILOUT) ISLP,IPRT,IPNN,IPEN,IPO,IRO,IPP,IRFN              &
     &  ,IGEN,NXZL,NITST,ISCTXT,IFILL,IALTGM,NLAYD,xadded,yadded,ntempin
      WRITE(90,*) ISLP,IPRT,IPNN,IPEN,IPO,IRO,IPP,IRFN              &
     &  ,IGEN,NXZL,NITST,ISCTXT,IFILL,IALTGM,NLAYD,xadded,yadded,ntempin
      WRITE(IFILOUT) HORIZ,VERT,XSALE,YSALE,XFACT,YFACT,AR,ANG 
      WRITE(90,*) 'IPP',IPP
      IF(IPP .GT. 0) WRITE(IFILOUT) ALINE 

      WRITE(IFILOUT) ((NOP(J,K),K=1,8),IMAT(J),THTA(J),J=1,NE) 
      WRITE(IFILOUT)                                                     &
        (XUSR(J),YUSR(J),WD(J),WIDTH(J),SS1(J),SS2(J),WIDS(J),         &
     &  WIDBS(J),SSO(J),BS1(J),J=1,NP)                                       

     WRITE(IFILOUT) NLST 
     IF(NLST .GT. 0) THEN 
        WRITE(IFILOUT) (LLIST(J),J=1,NLST),                              &
     &  ((ILIST(J,I),I=1,LLIST(J)),J=1,NLST)                          
      ENDIF 

      WRITE(IFILOUT) NENTRY,NLAYD,NCLM 

      IF(NENTRY .GT. 0) THEN 
        WRITE(IFILOUT) ((NEF(I,J),J=1,3),I=1,NENTRY) 
      ENDIF 

      IF(NLAYD .GT. 0) THEN 
        WRITE(IFILOUT) (LAY(I),I=1,NP)
      ENDIF 

      IF(NCLM .GT. 0) THEN 
        WRITE(IFILOUT) ((ICCLN(I,J),J=1,350),I=1,NCLM) 
      ENDIF
      REWIND IFILOUT
      RETURN
      END

      SUBROUTINE READRM1(IIIN)

      USE BLK1MOD
!      INCLUDE 'BLK1.COM'
      CHARACTER*48 DLIN

      IIN=IIIN
!  Read in header lines

      ISET=1
      WRITE(90,*) 'GOING TO HEADIN'
      CALL HEADIN(IIN,ISET)

!  Read in existing elements
      WRITE(90,*) 'GOING TO RDELEM'
      CALL RDELEM(IIN)

!  Read in nodal coordinates

      WRITE(90,*) 'GOING TO RDCORD'
      CALL RDCORD(IIN)

!  Close input file

      CLOSE(IIN)

!  Scale for plotting

      IF(NP .GT. 0) THEN
        DO  J=1,NP
          IF (CORD(J,1) .GT. VDX)  THEN
            XMIN=MIN(XMIN,CORD(J,1))
            XMAX=MAX(XMAX,CORD(J,1))
            YMIN=MIN(YMIN,CORD(J,2))
            YMAX=MAX(YMAX,CORD(J,2))
          ENDIF
        ENDDO
      ENDIF

      RETURN
      END

!    Read GEO file
      SUBROUTINE READGEO(IIIN)
      USE BLK1MOD
      CHARACTER*1000 HEADER
      CHARACTER*8 ID8
      CHARACTER*32 IJNK
      CHARACTER*80 ALINE,DLIN
!      INCLUDE 'BLK1.COM' 
      INCLUDE 'BFILES.I90'

      INTEGER*2 NOP2(MAXE,8)


      IIN=IIIN
      read(iin,err=100) header
      if(header(1:6) .eq. 'RMAGEN') then
        inopt=2
      else
        inopt=1
        rewind iin
      endif                                                               
      read(iin) n1,m1 
      rewind iin
      write(90,*) 'Apparent nodes and elements from file are' 
      write(90,'(i15,i10)') n1,m1 
      if(n1 .gt. maxp  .or.  m1 .gt. maxe) then 
!                                                                      
!...... Perhaps the file format is wrong, close and reopen              
!                                                                       
        WRITE(DLIN,'(A32)') 'Parameter limits may be violated' 
        call symbl(0.5,4.5,0.20,dlin,0.0,32) 
        WRITE(DLIN,'(A35)') 'Retrying with alternate file format' 
        call symbl(0.5,4.2,0.20,dlin,0.0,35) 
        close (iin) 
        open(iin ,file=fnamkep,status='old',form='unformatted') 
        read(iin) n1,m1 
        write(90,*) 'Revised nodes and elements from file are' 
        write(90,'(i15,i10)') n1,m1 
        if(n1 .gt. maxp  .or.  m1 .gt. maxe) then 
          WRITE(DLIN,'(A31)') 'Parameter limits still violated' 
          call symbl(0.5,3.9,0.20,dlin,0.0,31) 
          WRITE(DLIN,'(A27)') 'Apparent nodes and elts are' 
          call symbl(0.5,3.6,0.20,dlin,0.0,27) 
          WRITE(DLIN,'(2i10)') n1,m1 
          call symbl(0.5,3.3,0.20,dlin,0.0,20) 
          WRITE(DLIN,'(A24)') 'Press enter to terminate' 
          call symbl(0.5,4.5,0.20,dlin,0.0,24) 
          CALL GTCHARX(ijnk,ndig,5.0,4.0) 
!cipk aug00                read(*,'(i1)') junk 
          call quit_pgm 
        endif 
      endif 
      rewind iin 
! 
! 
      if(inopt .eq. 2) then
        read(iin,err=100) header     
        READ(IIN,ERR=100)                                           &
     &    N1,M1,((CORD(J,K),K=1,2),ALPHA,WD(J),J=1,N1),           &
     &          ((NOP(J,K),K=1,8),IMAT(J),THTA(J),I3,J=1,M1)      &
     &        , (WIDTH(J),SS1(J),SS2(J),WIDS(J),J=1,N1)          
        DO J=1,N1
  		  XUSR(J)=CORD(J,1)
		  YUSR(J)=CORD(J,2)
        ENDDO
!                                                              
      else
        READ(IIN,ERR=100)                                           &
     &    N1,M1,((CORDSN(J,K),K=1,2),ALPHA,WD(J),J=1,N1),           &
     &          ((NOP2(J,K),K=1,8),IMAT(J),THTA(J),I32,J=1,M1)      &
     &         , (WIDTH(J),SS1(J),SS2(J),WIDS(J),J=1,N1)          
        DO J=1,N1
          DO K=1,2
            CORD(J,K)=CORDSN(J,K)
          ENDDO
		  XUSR(J)=CORD(J,1)
		  YUSR(J)=CORD(J,2)
        ENDDO
        DO J=1,M1
!ipk feb08
 	      ncorn(j)=0
          DO K=1,8
            NOP(J,K)=NOP2(J,K)
!ipk feb08
            if(nop(j,k) .gt. 0) ncorn(j)=k
          ENDDO
        ENDDO  
      endif
      read(IIN,err=120,end=120) id8 
      if(id8(1:6) .eq. 'part-2') then 
        read(IIN,err=104) (widbs(j),sso(j),j=1,n1) 
        read(IIN,err=120,end=120) id8 
      endif            

!    Add part 3 write for continuity lines
      if(id8(1:6) .eq. 'part-3') then 

!ipk aug02              IF(NCLM .GT. 0) THEN
        READ(IIN,ERR=104) NCLM,((ICCLN(I,J),J=1,350),I=1,NCLM)
!ipk aug02			  ENDIF
        read(IIN,err=120,end=120) id8 
      endif 
!IPK DEB02  Add part 4 write for lock and BS1 lines and reordering
      if(id8(1:6) .eq. 'part-4') then 
        read(iin,err=104,end=120) (lock(j),bs1(j),j=1,n1)
	    read(iin,err=104,end=120) &
              nlst,((ilist(j,k),k=1,maeln),llist(j),j=1,maxln)
      endif                                                                        
      DO J=1,M1
!ipk feb08
	    ncorn(j)=0
        DO K=1,8
!ipk feb08
          if(nop(j,k) .gt. 0) ncorn(j)=k
        ENDDO
      ENDDO  

      GO TO 120 

  100 READ(IIN,ERR=104)                                           &
     &  N1,M1,((CORDSN(J,K),K=1,2),ALPHA,WD(J),J=1,N1),           &
     &        ((NOP2(J,K),K=1,8),IMAT(J),THTA(J),I32,J=1,M1)      
      DO J=1,N1
        DO K=1,2
          CORD(J,K)=CORDSN(J,K)
        ENDDO
 	    XUSR(J)=CORD(J,1)
	    YUSR(J)=CORD(J,2)
      ENDDO
      DO J=1,M1
!ipk feb08
	    ncorn(j)=0
        DO K=1,8
          NOP(J,K)=NOP2(J,K)
!ipk feb08
          if(nop(j,k) .gt. 0) ncorn(j)=k
        ENDDO
      ENDDO  
      GO TO 120 

  104 WRITE(90,*) 'Error reading binary geometry file' 
!ipk jan98            CALL SETD(23)                                     
      call clscrn() 
      WRITE(aline,*) 'Error reading binary geometry file' 
      call symbl                                                  &
     &      (1.1,3.3,0.20,aline,0.0,80)                                 
      WRITE(aline,*) 'Press enter to exit' 
      call symbl                                                  &
     &      (1.1,3.0,0.20,aline,0.0,80)                                 
      ndig=1 
      CALL GTCHARX(IJNK,NDIG,5.0,7.6) 
      CALL Quit_Pgm 
      STOP 

  120 CONTINUE 
      NP=N1 
      NE=M1 

!  Close input file

      CLOSE(IIN)

!  Scale for plotting

      IF(NP .GT. 0) THEN
        DO  J=1,NP
          IF (CORD(J,1) .GT. VDX)  THEN
            XMIN=MIN(XMIN,CORD(J,1))
            XMAX=MAX(XMAX,CORD(J,1))
            YMIN=MIN(YMIN,CORD(J,2))
            YMAX=MAX(YMAX,CORD(J,2))
          ENDIF
        ENDDO
      ENDIF
      RETURN

      END

      SUBROUTINE READGFG(IUNIT,ISW)

      USE BLK1MOD
      INCLUDE "BFILES.I90"
!     INCLUDE 'BLK1.COM'
      INCLUDE  'TXFRM.COM' 
      CHARACTER*1 ANS
      CHARACTER*32 ANS32
      CHARACTER*3 ID
      CHARACTER*77 DLIN
      CHARACTER*150 DLIN1
      CHARACTER*80 LIND 
      DIMENSION   NTMP(9),NTEMPLIN(200,10),ATT(9)

      REAL*8 CX,CY,VALS(7)

      MEL=MAXE 
      ylv=7.5
      IIN=IUNIT
      IPRT=1 
      IPNN=1 
      IPEN=1 
      IPO=1 
      IRO=1 
      IPP=0 
      IRFN=0 
      IGEN=0 
      NXZL=0 
      NITST=1 
      ISCTXT=0 
      IFILL=0 
      IALTGM=1 
      NLAYD=0 
      HORIZ=10. 
      VERT=8. 
      XSALE=0. 
      YSALE=0. 
      XFACT=0. 
      YFACT=0. 
      AR=0. 
      ANG=0. 
      xadded=0.
      yadded=0.
      ntempin=0.
      KLIN=0 
      IF(ABS(ISW) .EQ. 1) GO TO 500
      DO I=1,10000
        READ(IIN,'(A3,A77)') ID,DLIN
        IF(ID .EQ. 'T1 ') THEN
          TITLE(1:77)=DLIN
          GO TO 10
        ENDIF
      ENDDO
  10  CONTINUE
      REWIND IIN

!     READ ELEMENT  AND CCLINE DATA

   20 CONTINUE
      DO ICOUNTC=1,200000
        DO JJ=1,150
          DLIN1(JJ:JJ)=' '
        ENDDO
        READ(IIN,'(A3,A150)', END=175) ID,DLIN1
        IF(ID .EQ. 'GE '  .or.   ID .EQ. 'GO') THEN
!    Count the number of variables
          I=0
          ICOUNT=0
   25     CONTINUE
          IF(DLIN1(I+1:I+1) .NE. ' ') THEN
            GO TO 30
          ELSE
            I=I+1
            GO TO 25
          ENDIF
   30       I=I+1
          IF(I .EQ. 151) THEN
            ICOUNT =ICOUNT+1
            GO TO 40
          ENDIF
          IF(DLIN1(I:I) .EQ. ' '  .OR.  DLIN1(I:I) .EQ. ',') THEN
            ICOUNT=ICOUNT+1
   35       CONTINUE
            IF(I+1 .EQ. 151) GO TO 40
            IF(DLIN1(I+1:I+1) .EQ. ' ') THEN
              I=I+1
              GO TO 35
            ELSE
              GO TO 30
            ENDIF
          ELSE
            GO TO 30
          ENDIF
        ENDIF
      ENDDO
   40 CONTINUE
      IF(ID .EQ. 'GO') THEN
        KLIN=KLIN+1
        READ(DLIN1,*) (NTEMPLIN(KLIN,K),K=1,ICOUNT)
        GO TO 20
      ENDIF
      IF(ICOUNT .GT. 10) THEN
        READ(DLIN1,*) J, (NTMP(K),K=1,9),THT 
      ELSE
        READ(DLIN1,*) J, (NTMP(K),K=1,9)
      ENDIF


      IF (J .GE. MEL)  THEN 
        CALL SETD(23) 
!cipk aug00
        WRITE(lind,*)  ' Element number exceeds MAXE in RDELEM' 
        call symbl       (1.1,ylv-0.3,0.20,lind,0.0,80)                               
        ndig=1 
        WRITE(90,*)  ' Element number exceeds MAXE in RDELEM' 
        WRITE(lind,6000) 
        CALL GTCHARX(ANS32,IJNK,5.0,4.0) 
        CALL Quit_Pgm 
        STOP 
      ENDIF 
!                                                                       
!   Check to ensure there are no duplicate numbers in input stream      
!   of element connections                                              
!                                                                       
      DO K=1,7 
        IF(NTMP(K) .NE. 0) THEN 
          DO L=K+1,8 
            IF(NTMP(K) .EQ. NTMP(L)) THEN 
              CALL SETD(23) 
              DO  KK=1,8 
                NOP(J,KK) = NTMP(KK) 
              ENDDO
              IMAT(J)=NTMP(9)
              call eltdisp(j)
              DO  KK=1,8 
                NTMP(KK) = NOP(J,KK) 
              ENDDO
              NTMP(9)=IMAT(J)
              GO TO 45
            ENDIF 
          ENDDO 
        ENDIF
      ENDDO
   45 CONTINUE 
      DO K=1,8 
        NOP(J,K) = NTMP(K) 
        ND = NTMP(K) 
        IF (ND .GT. 0) THEN 
          INEW(ND) = 2 
          NP = MAX(NP,ND) 
        ENDIF 
      ENDDO 
!                                                                       
      NCN = 2 
      IF (NOP(J,3) .NE. 0) NCN = 3 
      IF (NOP(J,4) .NE. 0) NCN = 4 
      IF (NOP(J,5) .NE. 0  .AND.  NOP(J,4) .NE. 0)  NCN = 5 
      IF (NOP(J,5) .NE. 0  .AND.  NOP(J,4) .EQ. 0)  NCN = 6 
      IF (NOP(J,6) .NE. 0) NCN = 6 
      IF (NOP(J,7) .NE. 0) NCN = 8 
      NCORN(J) = NCN 
      IESKP(J) = 0 
      IMAT(J) = NTMP(9) 
      THTA(J)=THT 
      IEM(J) = J 
      DO 50  K=2,NCN,2 
      ND = NTMP(K) 
      IF (ND .GT. 0) THEN 
        IF(NCN .EQ. 5  .AND.  K .EQ. 4) GO TO 50 
        WD(ND)=0. 
      ENDIF
   50 CONTINUE 
      NE = MAX(J,NE) 
!                                                                       
      GOTO 20 
!                                                                       
  175 CONTINUE  

      REWIND IIN
   70 CONTINUE
      DO ICOUNTC=1,100000
        DO JJ=1,150
          DLIN1(JJ:JJ)=' '
        ENDDO
        READ(IIN,'(A3,A150)', END=400) ID,DLIN1
        IF(ID .EQ. 'GNN'  .OR.  ID .EQ. 'GWN') THEN
!    Count the number of variables
          I=0
          ICOUNT=0
   75     CONTINUE
          IF(DLIN1(I+1:I+1) .NE. ' ') THEN
            GO TO 80
          ELSE
            I=I+1
            GO TO 75
          ENDIF
   80     I=I+1
            IF(I .EQ. 151) THEN
              ICOUNT =ICOUNT+1
              GO TO 90
            ENDIF
            IF(DLIN1(I:I) .EQ. ' '  .OR.  DLIN1(I:I) .EQ. ',') THEN
              ICOUNT=ICOUNT+1
   85         CONTINUE
              IF(I+1 .EQ. 151) GO TO 90
              IF(DLIN1(I+1:I+1) .EQ. ' ') THEN
                I=I+1
                GO TO 85
              ELSE
                GO TO 80
              ENDIF
            ELSE
              GO TO 80
            ENDIF
        ENDIF
      ENDDO
   90 CONTINUE
      DO K=1,7
        VALS(K)=0.
      ENDDO
      READ(DLIN1,*) J,(VALS(K),K=1,ICOUNT-1)
	  IF(ID .EQ. 'GNN') THEN
        CX=VALS(1)
        CY=VALS(2)
        BELEV=VALS(3)
        NP = MAX(NP,J) 
        CORD(J,1) = CX 
        CORD(J,2) = CY 
        XUSR(J) = CX 
        YUSR(J) = CY 
        WD(J) = BELEV 
        INSKP(J)=0 
        INEW(J) = 1 
		  GO TO 70
  	  ELSE
  	    WDTHX=VALS(1)
        SS1X=VALS(2)
        SS2X=VALS(3)
        WDSX=VALS(4)
        WIDTH(J)=WDTHX 
        SS1(J)=SS1X 
        SS2(J)=SS2X 
        WIDS(J)=WDSX 
		  GO TO 70
  	  ENDIF

  400 CONTINUE

!     CHECKOUT THE CCLINE DATA

      KK=0
      IF(KLIN .GT. 0) THEN
        NCLM=1
        IF(NTEMPLIN(1,1) .EQ. 1) THEN
          DO K=1,KLIN
            DO J=1,10
              IF(K .EQ. 1  .AND. J .EQ. 1) GO TO 410
              IF(NTEMPLIN(K,J) .LT. 0) THEN
                NCLM=NCLM+1
                KK=0
                GO TO 420
              ELSEIF(NTEMPLIN(K,J) .EQ. 0) THEN
                GO TO 420
              ELSE
                KK=KK+1
                ICCLN(NCLM,KK)=NTEMPLIN(K,J)           
              ENDIF
  410         CONTINUE
            ENDDO
  420       CONTINUE
          ENDDO
          NCLM=NCLM-1
        ENDIF
      ENDIF
      RETURN

500   CONTINUE
      IF(ISW .EQ. -1) THEN
        NESV=NE
        NPSV=NP
      ENDIF
	  READ(IUNIT,*) NE,NCNTR,NATTR
      IMIDS=0
      NMESS=2
      inattr=1
      call GETINT(INATTR)
      
      DO JJ=1,NE    
	    READ(IUNIT,*) J,(NTMP(K),K=1,NCNTR),(ATT(K),K=1,NATTR)
        IF(ISW .EQ. -1) J=J+NESV
        IF (J .GE. MEL)  THEN 
          CALL SETD(23) 
          WRITE(lind,*)  ' Element number exceeds MAXE in RDELEM' 
          call symbl                                                      &
     &     (1.1,ylv-0.3,0.20,lind,0.0,80)                               
          ndig=1 
          WRITE(90,*)  ' Element number exceeds MAXE in RDELEM' 
          WRITE(lind,6000) 
          CALL GTCHARX(ANS32,IJNK,5.0,4.0) 
          CALL Quit_Pgm 
          STOP 
        ENDIF 
        DO  KK=1,3 
          IF(ISW .EQ. -1) THEN
              NOP(J,2*KK-1) = NTMP(KK)+NPSV
          ELSE
              NOP(J,2*KK-1) = NTMP(KK) 
          ENDIF
          NOP(J,2*KK)=0
        ENDDO
        IF(NATTR .GT. 0) THEN
          IMAT(J)=ATT(1)
        ELSE
          IMAT(J)=INATTR
        ENDIF
        NCORN(J)=6
        IESKP(J)=0
      ENDDO  
      NE=J
 	  CLOSE(IUNIT)
  	  DO L=255,1,-1
	    IF(FNAMKEP(L:L) .EQ. '.') THEN
	      FNAMKEP(L+1:L+4)='node'
	      OPEN(IUNIT,FILE=FNAMKEP,STATUS='OLD',ACTION='READ')
          GO TO 510
        ENDIF
      ENDDO
510   CONTINUE  
      
      READ(IUNIT,*) NPPP,NDUM,NATTR
  	  DO KK=1,NPPP
  	    READ(IUNIT,*) J,CX,CY,(VALS(K),K=1,NATTR)
        IF(ISW .EQ. -1) J=J+NPSV
        IF(J .EQ. 0) THEN
          J=NPPP
          JZ=1
        ENDIF
	    BELEV=-9999.
	    WEL=0.
	    LOCK1=0
	    IF(NATTR .GT. 0) BELEV=VALS(1)
        IF (J .GE. MAXP)  THEN 
          call clscrn() 
          WRITE(dlin,*)  ' Node number exceeds MAXP in RDCORD',j 
          call symbl                                                    &
     &    (1.1,3.3,0.20,dlin,0.0,80)                                    
          WRITE(90,*)  ' Node number exceeds MAXP in RDCORD' 
          WRITE(DLIN,*) ' Press enter to exit' 
          call symbl                                                    &
     &    (1.1,3.0,0.20,dlin,0.0,80)                                    
          ndig=1 
          CALL GTCHARX(ANS32,ndig,5.0,4.0) 
          CALL Quit_Pgm 
          STOP 
        ENDIF 
        NP = MAX(NP,J) 
        XUSR(J) = CX 
        YUSR(J) = CY 
        CORD(J,1) = (XUSR(J)+XS)/TXSCAL 
        CORD(J,2) = (YUSR(J)+YS)/TXSCAL 
        WD(J) = BELEV 
        WIDTH(J)=0.
        SS1(J)=0. 
        SS2(J)=0. 
        WIDS(J)=0. 
        WIDBS(J)=0. 
        SSO(J)=0. 
        INSKP(J)=0 
        INEW(J) = 1 
        LOCK(J)=LOCK1
        BS1(J)=0.
      ENDDO
      
 	  CLOSE(IUNIT)
 6000     FORMAT(' Press enter to exit') 
      END


      SUBROUTINE ZEROOUT

      USE BLK1MOD
!      INCLUDE 'BLK1.COM'

      MNP = MAXP
      MEL = MAXE
      DO I=1,MEL
        DO M=1,8
          NOP(I,M)=0
        ENDDO
        IESKP(I)=-1
        IEM(I) = 0
        IMAT(I) = 0
        THTA(I)=0.
        XC(I) = -1.E20
        YC(I) = -1.E20
      ENDDO
      DO I=1,MNP
         XUSR(I) = -1.D20
         YUSR(I) = -1.D20
         CORD(I,1) = -1.D20
         CORD(I,2) = -1.D20
         WD(I) = -9999.
         LAY(I) = -9999
         WIDTH(I) = 0.0
         SS1(I) = 0.0
         SS2(I) = 0.0
         WIDS(I) = 0.0
         WIDBS(I)=0.
         SSO(I)=0.
         INSKP(I) = 1
         INEW(I) = 0
!ipk mar02
         lock(i)=0
         bs1(I)=0.
      ENDDO 
      NP=0
      NE=0  
      RETURN
      END