!IPK  LAST UPDATE SEP 23 2015  ADD OPTION FOR SURFER FORMAT MAPS
!IPK  LAST UPDATE FEB 11 2002 ADD LOCK AS VARIABLE AND READ NEW MAP FILE
!ipk jan99 fix restart file                                             
!                                                                       
!                                                                       
!****************************************************************       
!                                                                       
      SUBROUTINE WRTOUT(IFOM) 
!ipk oct95  IFO replaced by IFOM because the value changes              
!                                                                       
!  Write out updated data                                               
!                                                                       
!     IFO = 0 write to backup                                           
!     IFO = 1 write to output in ASCII                                  
!IPK MAR94 add a line                                                   
!     IFO = -1 write to ASCII in emergency                              
!     IFO = 2 write to output as binary                                 
!                                                                       
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 
      CHARACTER*55 FMTT 
      CHARACTER*39 FMTU 
!IPK JUL98                                                              
      CHARACTER*8 ID8 
      CHARACTER*60 LIND 
      CHARACTER*32 IJNK 
!                                                                       
      DATA ISET /2/,ZERO/0.0/ 
!ipk oct95 copy IFO from IFOM                                           
!ipk feb99      IOT=20                                                  
!ipk feb99      IOT1=22                                                 
                                                                        
      IF((IFOM .EQ. 2  .AND. IOT1 .EQ. 0)  .OR.                         &
     &   (IFOM .EQ. 1  .AND. IOT .EQ. 0)) THEN                          
        CALL CLRBOX 
        WRITE(LIND,*) 'You have attempted to save without opening save f&
     &ile'                                                              
        CALL SYMBL(0.2,7.80,0.20,LIND,0.0,60) 
        WRITE(LIND,*) 'Press return to continue' 
        CALL SYMBL(0.2,7.55,0.20,LIND,0.0,60) 
        CALL GTCHARX(IJNK,NDIG,5.0,7.6) 
        CALL CLRBOX 
        RETURN 
      ENDIF 
      IFO=IFOM 
                                                                        
      IF(IFO .GT. 0) THEN 
!                                                                       
!  Check connectivity before saving                                     
!                                                                       
        CALL CHKCON(IREP) 
        IF(IREP .EQ. 0) RETURN 
      ENDIF 
!
!   Setup 1-D
      IOD=2
      DO N=1,NE
        IF(NCORN(N) .LT. 6) THEN
          IF(NCORN(N) .EQ. 5) THEN
            NCN=3
          ELSE
            NCN=NCORN(N)
          ENDIF
          DO K=1,NCN
            INODE=NOP(N,K)
            IF(INODE .GT. 0) IOD(INODE)=1
          ENDDO
        ELSE
          DO K=1,8
            INODE=NOP(N,K)
            IF(INODE .GT. 0) then
              IF(IOD(INODE) .EQ. 2) IOD(INODE)=0
            ENDIF
          ENDDO
        ENDIF
      ENDDO
      DO J=1,NP
        IF(IOD(J) .EQ. 0) THEN
          WIDTH(J)=0.
          SS1(J)=0.
          SS2(J)=0.
          WIDS(J)=0.
          WIDBS(J)=0.
          SSO(J)=0.
          BS1(J)=0.
        ENDIF
      ENDDO
!IPK MAR94 add a line                                                   
      IFO = ABS(IFO)
	  if((ifo .eq. 1  .and. igfgsw .eq. 0)  .or.  ifo .ne. 1) then
        if(itrianout .eq. 0) CALL HEADIN(IFO,ISET) 
	  endif
      IF(IFO .EQ. 0 ) THEN 
        WRITE(IBAK) ((NOP(J,K),K=1,8),IMAT(J),THTA(J),J=1,NE) 
        WRITE(IBAK)                                                     &
     &   (XUSR(J),YUSR(J),WD(J),WIDTH(J),SS1(J),SS2(J),WIDS(J),         &
     &    WIDBS(J),SSO(J),BS1(J),J=1,NP)                                       
!IPK MAR02 add BS1
!IPK JUL98     +   (XUSR(J),YUSR(J),WD(J),WIDTH(J),SS1(J),SS2(J),WIDS(J)
        WRITE(IBAK) NLST 
        IF(NLST .GT. 0) THEN 
          WRITE(IBAK) (LLIST(J),J=1,NLST),                              &
     &    ((ILIST(J,I),I=1,LLIST(J)),J=1,NLST)                          
        ENDIF 
!IPK JAN01
        WRITE(IBAK) NENTRY,NLAYD,NCLM 
        IF(NENTRY .GT. 0) THEN 
          WRITE(IBAK) ((NEF(I,J),J=1,3),I=1,NENTRY) 
        ENDIF 
        IF(NLAYD .GT. 0) THEN 
          WRITE(IBAK) (LAY(I),I=0,NP),((WTLAY(I,J),J=1,9),I=0,NP)
        ENDIF 
!IPK JAN01
        IF(NCLM .GT. 0) THEN 
          WRITE(IBAK) ((ICCLN(I,J),J=1,350),I=1,NCLM) 
        ENDIF
		IF(IBAK .EQ. 21) THEN 
          CLOSE (IBAK)
          OPEN(IBAK,FILE='ELT.BAK',STATUS='UNKNOWN',FORM='UNFORMATTED',IOSTAT=iost)
	      if(iost .gt. 0) then
            OPEN(IBAK,FILE='ELT1.BAK',STATUS='UNKNOWN',FORM='UNFORMATTED',IOSTAT=iost)
  	        if(iost .gt. 0) then
              OPEN(IBAK,FILE='ELT2.BAK',STATUS='UNKNOWN',FORM='UNFORMATTED',IOSTAT=iost)
              if(iost .gt. 0) then
                write(*,*) 'ERROR UNABLE TO OPEN ELT.BAK FILE'
                write(*,*) 'PRESS RETURN TO END'
                read(*,'(I5)') junk
                STOP
		      endif
            ENDIF
          ENDIF
!          OPEN(IBAK,FILE='ELT.BAK',STATUS='UNKNOWN',FORM='BINARY')
		ENDIF
 
      ELSEIF(IFO .EQ. 2) THEN 
	    if(igfgswb .eq. 0) then
!ipk may02            REWIND IOT1 
            WRITE(IOT1)                                                 &
     &      NP,NE,(XUSR(J),YUSR(J),ZERO,WD(J),J=1,NP),                  &
     &      ((NOP(J,K),K=1,8),IMAT(J),THTA(J),IEM(J),J=1,NE),           &
     &      (WIDTH(J),SS1(J),SS2(J),WIDS(J),J=1,NP)                     
!IPK JUL98                                                              
            ID8='part-2  ' 
            WRITE(IOT1) ID8 
            WRITE(IOT1) (WIDBS(J),SSO(J),J=1,NP)

!IPK JAN01  Add part 3 write for continuity lines
            IF(NCLM .GT. 0) THEN
              ID8='part-3  ' 
              WRITE(IOT1) ID8 
              WRITE(IOT1) NCLM,((ICCLN(I,J),J=1,350),I=1,NCLM)
            ENDIF 
!IPK JAN01  Add part 4 write for continuity lines
            ID8='part-4  ' 
            WRITE(IOT1) ID8 
!ipk mar02 add BS1
            write(iot1) (lock(j),bs1(j),j=1,np),&
            nlst,((ilist(j,k),k=1,maeln),llist(j),j=1,maxln)
        else
          call wrtbin
		endif
      ELSE 
	   if(igfgsw .eq. 0  .and.  itrianout .eq. 0) then
        IOF=IOT

        JJ=0
        DO 10  J=1,NE 
          IF (IMAT(J) .NE. 0)  THEN 
            JJ=JJ+1
            IF(IECHG .EQ. 0) IEM(JJ)=JJ 

            if(np .lt. 100000) then
              WRITE(IOF,'(10I5,F10.3,I5)')                                &
     &      J, (NOP(J,K),K=1,8), IMAT(J),THTA(J),IEM(JJ)                 
            else
              WRITE(IOF,'(10I6,F10.3,I6)')                                &
     &      J, (NOP(J,K),K=1,8), IMAT(J),THTA(J),IEM(JJ)                 
	        endif
          ENDIF 
   10   CONTINUE 
!                                                                       
!ipk jan98 restore 9999                                                 
        if(np .lt. 100000) then
          WRITE(IOF,'(I5)')  9999 
		else
          WRITE(IOF,'(I6)')  9999 
		endif
!                                                                       
!  Write out nodal data                                                 
!                                                                       
!ipk jun97 find max or min number in x or y                             
        cminx=0. 
        cmaxx=0. 
        wdmin=1.e10
        wdmax=-1.e10
        do j=1,np 
          if(inew(j) .eq. 1) then 
!            write(90,*) j,xusr(j),yusr(j)
            if(xusr(j) .gt. cmaxx) cmaxx=xusr(j) 
            if(yusr(j) .gt. cmaxx) cmaxx=yusr(j) 
            if(xusr(j) .lt. cminx) cminx=xusr(j) 
            if(yusr(j) .lt. cminx) cminx=yusr(j) 
            wdmin=min(wdmin,wd(j))
            wdmax=max(wdmax,wd(j))
          endif 
        enddo 
        if(abs(wdmin) .gt. abs(wdmax)) then
          temp=log10(abs(wdmin))
        elseif(wdmax .eq. 0.) then
          temp=2.5
        else
          temp=log10(abs(wdmax))
        endif
        if(temp .gt. 2.) then
          itp=3
        elseif(temp .gt. 1.) then
          itp=4
        else
          itp=5
        endif
        ndigp=1 
        if(cmaxx .gt. 1.) then 
          ndigp=int(log10(cmaxx))+1 
        endif 
        ndigm=2 
        if(abs(cminx) .gt. 1.) then 
          ndigm=int(log10(abs(cminx)))+2 
        endif 
        ndigo=max(ndigp,ndigm) 
        ndec=min(8-ndigo,4) 
!        write(90,*) 'ndigp',ndigp,ndigm,cmaxx,cminx,ndigo,ndec
        if(ntempin .lt. 2) then
          write(fmtt,6200) NDEC,NDEC,itp 
!IPK JUL98 6200   format('(I10,F10.',i1,',F10.'I1,',F10.3,F10.1,2F10.3,F
!IPK FEB02 ALLOW FOR LOCK AND BS1
 6200     format('(I10,F10.',i1,',F10.'I1,',F10.',I1,',F10.1,2F10.3,3F10.2,I10,F10.4)') 
          WRITE(FMTU,6201) NDEC,NDEC,ITP 
!IPK FEB02 ALLOW FOR LOCK AND BS1
 6201     format('(I10,F10.',i1,',F10.'I1,',F10.',I1,',60X,I10,F10.4)') 
        else
        ndec=min(14-ndigo,4) 
!          write(fmtt,6202) NDEC+10,NDEC+10,ITP 
          write(fmtt,6202) NDEC+9,NDEC+9,ITP 
 6202     format('(I10,g20.',i2,',g20.'I2,',F10.',I1,',F10.1,2F10.3,3F10.2,I10,F10.4)') 
!          WRITE(FMTU,6203) NDEC+10,NDEC+10,ITP
          WRITE(FMTU,6203) NDEC+9,NDEC+9,ITP
 6203     format('(I10,g20.',i2,',g20.'I2,',F10.',I1,',60X,I10,F10.4)') 
        endif
        DO 20 J=1,NP 
          IF (INEW(J) .EQ. 1)  THEN 
!ipk oct94            IF(WIDTH(J) .GT. 0.01) THEN                       
            IF(WIDTH(J) .GT. 0.001  .or.  bs1(j) .gt. 0.) THEN 
!ipk feb97              WRITE(IOF, '(I10,2F10.3,F10.2,F10.1,2F10.3,F10.1
!IPK JUL97              WRITE(IOF, '(I10,3F10.3,F10.1,2F10.3,F10.1)')   
!IPK FEB02   ADD LOCK AND BS1

              WRITE(IOF, FMTT)                                          &
     &        J,XUSR(J),YUSR(J),WD(J),                                  &
     &        WIDTH(J),SS1(J),SS2(J),WIDS(J)                            &
     &       ,WIDBS(J),SSO(J),LOCK(J),BS1(J)
                                                                        
            ELSE 
!              write(90,7777) fmtu,j,xusr(j),yusr(j),ndec,ndigo
 7777   format(3x,a23,i5,2e15.6,2i8)
          
!ipk feb97              WRITE(IOF, '(I10,2F10.3,F10.2)')                
!IPK JUL97     WRITE(IOF, '(I10,3F10.3)')    
!ipk feb02 add lock AND BS1            
              WRITE(IOF, FMTU)                                          &
     &        J,XUSR(J),YUSR(J),WD(J),lock(j),BS1(J)                                   
            ENDIF 
          ENDIF 
   20   CONTINUE 
!ipk jan98 restore 9999                                                 
        WRITE(IOF,'(I10)') 9999 
        IF(NLST .GT. 0) THEN 
          DO 30 J=1,NLST 
            IF(LLIST(J) .GT. 0) THEN
			  if(np .lt. 100000) then 
                WRITE(IOF,'(16I5)') (ILIST(J,I),I=1,LLIST(J))
		      else
			    WRITE(IOF,'(16I6)') (ILIST(J,I),I=1,LLIST(J))
			  endif 
            ENDIF 
   30     CONTINUE 
        ENDIF 
!ipk jan98 restore 9999                                                 
        WRITE(IOF,'(I5)') 9999 
!        IF(NLAYD .GT. 0) THEN 
!          WRITE(IOF,'(2I5)') (I,LAY(I),I=1,NP) 
!        ENDIF 
        WRITE(IOF,6000) NENTRY 
 6000   FORMAT(I5,20X,'NENTRY') 
        IF(NENTRY .GT. 0) THEN 
          WRITE(IOF,'(15I5)') (NEF(I,1),NEF(I,2),NEF(I,3),I=1,NENTRY) 
        ENDIF
        WRITE(IOF,6001) NCLM 
 6001   FORMAT(I5,20X,'NCLM')
        IF(NCLM .GT. 0) THEN
          DO I=1,NCLM
            DO J=1,350
              IF(ICCLN(I,J) .EQ. 0) THEN
                NTRAC=J-1
                IF(NTRAC .GT. 0) THEN
                  WRITE(IOF,6002) I,(ICCLN(I,KK),KK=1,NTRAC) 
 6002             FORMAT('CC1',I5,9I8/('CC2',5X,9I8)) 
                ELSE
                  WRITE(IOF,6002) I
                ENDIF
                GO TO 40
              ENDIF
            ENDDO
   40       CONTINUE
          ENDDO
        ENDIF 
        WRITE(IOF,6003)
 6003   FORMAT('ENDDATA')
       elseif(itrianout .gt. 0) then
	     call wrtele(IOT,itrianout)
       else
	     call wrtgfg(IOT)
       endif                                                          
      ENDIF 
      RETURN 
      END                                           
!****************************************************************       
      SUBROUTINE HEADIN(IUNIT,ISET) 
!                                                                       
!     Read and write header data                                        
!                                                                       
!****************************************************************       
!                                                                       
      USE BLK1MOD
      INTEGER*2 I32 
      CHARACTER*80 ALINE 
!ipk dec97                                                              
      character*40 dlin 
      CHARACTER*32 IJNK 
!IPK JUL98                                                              
!ipk may02
      CHARACTER*8 ID8 
      CHARACTER*3 ID
      CHARACTER*1000 HEADER

      COMMON /RECOD/ IRECD,TSPC
!      INCLUDE 'BLK1.COM' 
      INCLUDE 'BFILES.I90'
      INTEGER*2 NOP2(MAXE,8)
      DATA ISLP/0/,IPRT/1/,IPO/1/,IRO/1/,IRFN/0/,IGEN/0/,NXZL/0/,NITST/1/,ISCTXT/0/,IFILL/0/,IALTGM/1/ 
      DATA HORIZ/10./,VERT/8./,XSALE/1./,YSALE/1./,XFACT/1./,YFACT/1./,AR/0./,ANG/0./
 !   ELSE
            !ISLP=0
            !IPRT=1
            !IPO=1 
            !IRO=1 
            !IRFN=0 
            !IGEN=0 
            !NXZL=0 
            !NITST=1 
            !ISCTXT=0 
            !IFILL=0 
            !IALTGM=1 



!     IF   ISET    =     1   read file
!     IUNIT   =     0   get a title 
!     IUNIT   ne    0   and    IIN   =   11    read RST header
!     IUNIT   ne    0   and    IIN   =   12    read GEO data
!     IUNIT   ne    0   and    IIN   =   10    read RM1 header
!     IUNIT   ne    0   and    IIN   =   10    ITRIAN .NE. 0  read ELE header
!     IF   ISET    =     2   write file
!     IUNIT   =     0   write a backup header
!     IUNIT   =     0   write RM1 header

!                                                                       
      IF(ISET .EQ. 1) THEN 
        IF(IUNIT .EQ. 0) THEN 
!                                                                       
!     Generate values                                                   
!                                                                       
          CALL SETD(23) 
!ipk oct96  WRITE(*,*) 'Enter a title for output file'                  
            WRITE(DLIN,'(a29)') 'Enter a title for output file' 
!ipk oct96 change to dlin                                               
!            call symbl(0.5,5.0,0.25,dlin,0.0,29)                       
!            ndig=29                                                    
!            call gtcharx(title,ndig,0.,4.5)                            
                                                                        
            IF(IRECD .NE. 2) call get_label(dlin,title) 
                                                                        
!                                                                       
                                                                        
!ipk oct96 end changes                                                  
!ipk oct96            READ(*,5000) TITLE                                
          CALL SETD(2) 
!          ISPL=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. 
        ELSE 
          IF(IIN .EQ. 11) THEN 
!IPK FEB03            READ(IIN) TITLE,NP,NE 
!IPK FEB03            READ(IIN) ISLP,IPRT,IPNN,IPEN,IPO,IRO,IPP,IRFN              &
!IPK FEB03     &  ,IGEN,NXZL,NITST,ISCTXT,IFILL,IALTGM,NLAYD,xadded,yadded,ntempin                      
!IPK FEB03            READ(IIN) HORIZ,VERT,XSALE,YSALE,XFACT,YFACT,AR,ANG 
!IPK FEB03            IF(IPP .GT. 0) READ(IIN) ALINE 
            CALL RDRST(1,IIN)

          ELSEIF(IIN .EQ. 12) THEN 
            CALL SETD(23) 
            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. 
 !ipk oct96  WRITE(*,*) 'Enter a title for output file'                  
            WRITE(dLIN,'(a29)') 'Enter a title for output file' 
                                                                        
            call get_label(dlin,title) 
                                                                        
!            call symbl(0.5,5.0,0.25,dlin,0.0,29)                       
!            ndig=29                                                    
!            call gtcharx(title,ndig,0.,4.5)                            
                                                                        
!ipk oct96 end changes                                                  
!ipk oct96            READ(*,5000) TITLE                                
            CALL SETD(2) 
            IF(IGFG .EQ. 2) THEN
              CALL RDBIN(IIN)
              RETURN
            ENDIF
!ipk dec97
            read(iin,err=100) header
            if(header(1:6) .eq. 'RMAGEN'  .or.  header(1:6) .eq. 'RMASIM') 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 
!ipk dec97 end changes                                                  
!ipk may02
            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)          
!IPK JUL98                                                              
            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
              ENDDO
              DO J=1,M1
                DO K=1,8
                  NOP(J,K)=NOP2(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            

!IPK JAN01  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=90) &
              nlst,((ilist(j,k),k=1,maeln),llist(j),j=1,maxln)
            endif                                                                        
            GO TO 120 
!IPK MAR04
   90       NLST=0
            DO J=1,MAXLN
              LLIST(J)=0
              DO K=1,MAELN
                ILIST(J,K)=0
              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
            ENDDO
            DO J=1,M1
              DO K=1,8
                NOP(J,K)=NOP2(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 
          ELSE
           IF(IGFG .EQ. 0  .AND.  ITRIAN .EQ. 0) THEN 
            READ(IIN,5000) TITLE 
            write(90,5000) title 
 5000       FORMAT( A80) 
            READ(IIN,5010) ISLP,IPRT,IPNN,IPEN,IPO,IRO,IPP,IRFN         &
     &  ,IGEN,NXZL,NITST,ISCTXT,IFILL,IALTGM,NLAYD,xadded,yadded,ntempin                      
            write(90,5010) ISLP,IPRT,IPNN,IPEN,IPO,IRO,IPP,IRFN         &
     &  ,IGEN,NXZL,NITST,ISCTXT,IFILL,IALTGM,NLAYD,xadded,yadded,ntempin                      
 5010       FORMAT( 15I5,2f10.1,i10) 
            READ(IIN,5011) HORIZ,VERT,XSALE,YSALE,XFACT,YFACT,AR,ANG 
 5011       FORMAT( 2F10.0,4F10.4,2F10.0 ) 
            IF(IPP .GT. 0) READ(IIN,5012) ALINE 
 5012       FORMAT(A80) 
           ELSEIF(IGFG .GT. 0  .OR. ITRIAN .EQ. 1) THEN
            write(90,*) 'reading gfg/TRIAN title'
            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. 
			IF(IGFG .EQ. 1) THEN
             DO I=1,10000
              READ(IIN,'(A3,A77)') ID,DLIN
              IF(ID .EQ. 'T1 ') THEN
                TITLE(1:77)=DLIN
                GO TO 140
              ENDIF
             ENDDO
			ELSEIF(IGFG .EQ. 3) THEN
             DO I=1,10000
              READ(IIN,'(A8,A77)') ID8,DLIN
              IF(ID8 .EQ. 'MESHNAME') THEN
                TITLE(1:77)=DLIN
                GO TO 140
              ENDIF
             ENDDO
            ENDIF
  140       CONTINUE
            REWIND IIN
           ENDIF
          ENDIF 
        ENDIF 
      ELSE 
        IF(IUNIT .EQ. 0 ) THEN
          IF(IPNN .NE. 1) THEN
            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
          ENDIF
          REWIND IBAK 
          WRITE(IBAK) TITLE,NP,NE 
          WRITE(IBAK) ISLP,IPRT,IPNN,IPEN,IPO,IRO,IPP,IRFN              &
     &  ,IGEN,NXZL,NITST,ISCTXT,IFILL,IALTGM,NLAYD,xadded,yadded,ntempin
          WRITE(IBAK) HORIZ,VERT,XSALE,YSALE,XFACT,YFACT,AR,ANG 
          IF(IPP .GT. 0) WRITE(IBAK) ALINE 
        ELSEIF(IUNIT .EQ. 1) THEN 
          IOF=IOT 
          REWIND IOF 
!ipk nov02	
!IPK MAR04	 
!  	  	  if(ne .gt. 99999) then
  	  	  if(np .gt. 99999) then
		    if(ntempin .eq. 0) then 
		      ntempin=1
		    else
		      ntempin=3
		    endif
		  endif
          ISLP=0
          IPRT=1 
          IPO=1 
          IRO=1 
          IPP=0
          IRFN=0
          IGEN=0 
          NXZL=0 
          NITST=1 
          ISCTXT=0 
          IFILL=0 
          IALTGM=1 
          NLAYD=0 
          HORIZ=0
          VERT=0
          XSALE=0
          YSALE=0
          XFACT=0
          YFACT=0
          AR=0
          ANG=0
          WRITE(IOF,5000) TITLE 
          WRITE(IOF,5010) ISLP,IPRT,IPNN,IPEN,IPO,IRO,IPP,IRFN          &
     &  ,IGEN,NXZL,NITST,ISCTXT,IFILL,IALTGM,NLAYD,xadded,yadded,ntempin
          WRITE(IOF,5011) HORIZ,VERT,XSALE,YSALE,XFACT,YFACT,AR,ANG 
          IF(IPP .GT. 0) WRITE(IOF,5012) ALINE 
        ENDIF 
      ENDIF 
      RETURN 
      END                                           
!                                                                       
      SUBROUTINE RDCORD(IUNIT) 
!                                                                       
!  Read in coordinates                                                  
!                                                                       
!IPK MAY02
      USE WINTERACTER
      USE BLK1MOD
      
      include 'd.inc'
                                                                 
      REAL*8 CX,CY,VALS(7)


      DIMENSION IRLINE(16) 
      CHARACTER*1 IJNK,ans 
      character*30 blank 
      CHARACTER*32 ANS32
      CHARACTER*77 DLIN2
	  CHARACTER*28 MESG
      CHARACTER*3 ID
      character*80 dlin
!ipk feb02 expand to 110 
      character*150 dlin1 
!      INCLUDE 'BLK1.COM' 
      DATA  IFIRST / 0 / 
      data blank/'                              '/ 
!                 
      IF (IFIRST .EQ. 0)  THEN 
         IF(IIN .EQ. 10) THEN 
           NP = 0 
         ENDIF 
         VOID = - 1.0E+10 
         VDX =  -1.E+9 
         IFIRST = 1 
      ENDIF 
	  ISTART=0
      JZ=0
!                                                                       
!                                                                       
      IF(IUNIT .EQ. 0) RETURN 
      IF(IUNIT .EQ. 10) THEN
        IF(IGFG .gt. 0) REWIND IUNIT 
!ipk oct96 upgrade to model limits                                      
   20   continue 
       IF(IGFG .EQ. 0  .AND.  ITRIAN .EQ. 0) THEN
!IPK JUL98        read(iunit,'(a80)',end=98) dlin                       
!ipk feb02 expand to 110
!ipk may02 expand to 150
        read(iunit,'(a150)',end=98) dlin1 
        if(dlin1(11:30) .eq. blank) go to 98 
!IPK JUL98        READ(dlin,'(I10,7F10.0)')  J, CX, CY, BELEV,          
!ipk feb02 add lock and BS1
        if(ntempin .lt. 2) then
          READ(dlin1,'(I10,9F10.0,I10,F10.0)')  J, CX, CY, BELEV,                   &
     &               WDTHX,SS1X,SS2X,WDSX,WEL,SSSO,LOCK1,BS11
        else
          READ(dlin1,'(I10,2f20.0,7F10.0,I10,F10.0)',err=8888)  J, CX, CY, BELEV,                   &
     &      WDTHX,SS1X,SS2X,WDSX,WEL,SSSO,LOCK1,BS11  
        go to 8889
 8888   do kcl=61,140
              dlin1(kcl:kcl)=' '
            enddo
        READ(DLIN1,'(I10,2F20.0,7F10.0,I10,F10.0)')  J, CX, CY, BELEV,&
            WDTHX,SS1X,SS2X,WDSX,WEL,SSSO,LOCK1,BS11 
8889 continue 

                    
        endif
       ELSEIF(ITRIAN .EQ. 1) THEN
	     IF(ISTART .EQ. 0) THEN
           READ(IUNIT,*) NPPP,NDUM,NATTR
		   ISTART=1
		 ENDIF
		 READ(IUNIT,*) J,CX,CY,(VALS(K),K=1,NATTR)
         IF(J .EQ. 0) THEN
           J=NPPP
           JZ=1
         ENDIF
		 BELEV=-9999.
         WDTHX=0.
		 SS1X=0.
		 SS2X=0.
		 WDSX=0.
		 WEL=0.
		 SSSO=0.
		 LOCK1=0
		 BS11=0.
		 IF(NATTR .GT. 0) BELEV=VALS(1)
		 IF(NATTR .GT. 1) WDTHX=VALS(2)
		 IF(NATTR .GT. 2) SS1X=VALS(3)
		 IF(NATTR .GT. 3) SS2X=VALS(4)
        
       ELSE

!ipk jun02 Allow for GFGEN input
        DO ICOUNTC=1,1000000
          DO JJ=1,150
           DLIN1(JJ:JJ)=' '
          ENDDO
          READ(IUNIT,'(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
          ELSEIF(ID(1:2) .EQ. 'ND') THEN
            ICOUNT=4 
            go to 90
          ENDIF
        ENDDO
   90   CONTINUE
        DO K=1,7
          VALS(K)=0.
        ENDDO
        READ(DLIN1,*) J,(VALS(K),K=1,ICOUNT-1)
!        WRITE(109,'(A8,I8,10F15.6)') ID,J,(VALS(K),K=1,ICOUNT-1)
		IF(ID .EQ. 'GNN'  .OR.  ID .EQ. 'ND ') 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 20
		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 20
		ENDIF
       ENDIF
!c        IF (J .GT. 9000)  GOTO 98                                     
        IF (J .GE. MAXP)  THEN 
!ipk jan98          CALL SETD(23)                                       
          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) 
!ipk jan98          READ(*,'(A)') IJNK                                  
          CALL Quit_Pgm 
          STOP 
        ENDIF 
        NP = MAX(NP,J) 
        CORD(J,1) = CX 
        CORD(J,2) = CY 
        XUSR(J) = CX 
        YUSR(J) = CY 
        WD(J) = BELEV 
        WIDTH(J)=WDTHX 
          SS1(J)=SS1X 
          SS2(J)=SS2X 
        WIDS(J)=WDSX 
!IPK JUL98                                                              
        WIDBS(J)=WEL 
        SSO(J)=SSSO 
        INSKP(J)=0 
        INEW(J) = 1 
!IPK FEB02 ADD LOCK
        LOCK(J)=LOCK1
        BS1(J)=BS11
		IF(ITRIAN .EQ. 1) THEN
          IF((JZ .EQ. 0  .AND. J .EQ. NPPP)  .OR.  (JZ .EQ. 1  .AND. J .EQ. NPPP-1)) GO TO 400
        ENDIF
!                                                                       
        GOTO 20 
!                                                                       
   98   CONTINUE 
        NLST=0 
        KK=0 
  102   continue
        if(np .gt. 99999) then
		  READ(IUNIT,'(16I6)') IRLINE
        else
          READ(IUNIT,'(16I5)') IRLINE
		endif   
        IF(IRLINE(1) .EQ. 9999  .or.  IRLINE(1) .EQ. 99999)  GO TO 300 
        IF(KK .EQ. 0) NLST=NLST+1 
  104   DO 105 K=1,16 
          IF(IRLINE(K) .EQ. 0) GO TO 106 
          KK=KK+1 
          ILIST(NLST,KK)=IRLINE(K) 
  105   CONTINUE 
        GO TO 102 
  106   CONTINUE 
        LLIST(NLST)=KK 
        KK=0 
        GO TO 102 
  300   CONTINUE 
!        IF(NLAYD .GT. 0) THEN 
!          DO 320 L=1,NP 
!            READ(IUNIT,'(2I5)') I,LAY(I) 
!            IF(I .GT. 9000) GO TO 325 
!  320     CONTINUE 
!  325     CONTINUE 
!        ENDIF 
!IPK JAN01
        READ(IUNIT,'(I5)',end=375) NENTRY
        IF(NENTRY .GT. 0) THEN
          READ(IUNIT,'(15I5)') (NEF(I,1),NEF(I,2),NEF(I,3),I=1,NENTRY) 
        ENDIF
        READ(IUNIT,'(I5)', end=375) NCLM
        write(90,*) 'INOUT-695  NCLM',nclm
        IF(NCLM .GT. 0) THEN
          READ(IUNIT,'(A3,A77)') ID,DLIN2
         WRITE(90,'(''INOUT-698'',A3,A77)'),ID,DLIN
          IF(ID .EQ. 'CC1') THEN
  330       READ(DLIN2,'(I5,9I8)') I,(ICCLN(I,J),J=1,9)
            WRITE(90,'(I5,9I8)') I,(ICCLN(I,J),J=1,9)
            NL=1
  340       NL=NL+9
            READ(IUNIT,'(A3,A77)',end=375) ID,DLIN2
            WRITE(90,'(''INOUT-705'',A3,A77)'),ID,DLIN
            IF(ID .EQ. 'CC2') THEN
              READ(DLIN2,'(5X,9I8)') (ICCLN(I,J),J=NL,NL+8)
            ELSEIF(ID .EQ. 'CC1') THEN
              GO TO 330
            ELSEIF(ID .EQ. 'END') THEN
              GO TO 375
            ENDIF
            GO TO 340
          ENDIF 
        ENDIF

  375   CONTINUE 
        WRITE(90,*) 'INOUT-718  NCLM',NCLM
      ELSE 
        IF(IUNIT .EQ. 11) THEN 
!IPK FEB03          READ(IUNIT)                                                   &
!IPK FEB03     &   (XUSR(J),YUSR(J),WD(J),WIDTH(J),SS1(J),SS2(J),WIDS(J),         &
!IPK FEB03     &    WIDBS(J),SSO(J),BS1(J),J=1,NP)                                       
!IPK FEB03!ipk jan99    +    (XUSR(J),YUSR(J),WD(J),WIDTH(J),SS1(J),SS2(J),WIDS(J)
!IPK FEB03          DO 350 J=1,NP 
!IPK FEB03            CORD(J,1) = XUSR(J) 
!IPK FEB03            CORD(J,2) = YUSR(J) 
!IPK FEB03            INSKP(J)=0 
!IPK FEB03            IF (CORD(J,1) .GT. VDX)  THEN 
!IPK FEB03              INEW(J) = 1 
!IPK FEB03            ENDIF 
!IPK FEB03  350     CONTINUE 
!IPK FEB03          READ(IUNIT) NLST 
!IPK FEB03          IF(NLST .GT. 0) THEN 
!IPK FEB03            READ(IUNIT) (LLIST(J),J=1,NLST),                            &
!IPK FEB03            ((ILIST(J,I),I=1,LLIST(J)),J=1,NLST)                        
!IPK FEB03          ENDIF 

!IPK FEB03          READ(IUNIT) NENTRY,NLAYD,NCLM
!IPK FEB03          IF(NENTRY .GT. 0) THEN 
!IPK FEB03            READ(IUNIT) ((NEF(I,J),J=1,3),I=1,NENTRY) 
!IPK FEB03          ENDIF 
!IPK FEB03          IF(NLAYD .GT. 0) THEN 
!IPK FEB03            READ(IUNIT) (LAY(I),I=1,NP) 
!IPK FEB03          ENDIF 
!IPK FEB03          IF(NCLM .GT. 0) THEN 
!IPK FEB03            READ(IUNIT) ((ICCLN(I,J),J=1,350),I=1,NCLM) 
!IPK FEB03          ENDIF 

          CALL RDRST(3,IUNIT)

        ELSE 
          DO 360 J=1,NP 
            XUSR(J) = CORD(J,1) 
            YUSR(J) = CORD(J,2) 
!!apr99            INSKP(J)=0 
            IF (CORD(J,1) .GT. VDX)  THEN 
              INSKP(J)=0 
              INEW(J) = 1 
            ENDIF 
  360     CONTINUE 
        ENDIF 
      ENDIF 
  400 CONTINUE
        WRITE(90,*) 'INOUT-762  NCLM',NCLM

!
!ipk jun02 look for nodes that do not have coordinates but are defined in NOP

      do n=1,ne
        if(imat(n) .gt. 0) then
          ncn=ncorn(n)
          if(ncn .eq. 3) then
            n1=nop(n,2)
            if(n1 .ne. 0) then
              if(inew(n1) .ne. 1) then
                cord(n1,1)=(cord(nop(n,1),1)+cord(nop(n,3),1))/2.
                cord(n1,2)=(cord(nop(n,1),2)+cord(nop(n,3),2))/2.
                XUSR(n1) = CORD(n1,1) 
                YUSR(n1) = CORD(n1,2) 
                INSKP(n1)=0 
                INEW(n1) = 1 
              endif
			endif
          elseif(ncn .gt. 5) then
            do k=2,ncn,2
              n1=nop(n,k)
              IF(N1 .NE. 0) THEN
                if(inew(n1) .ne. 1) then
                  kk=mod(k+1,ncn)
                 cord(n1,1)=(cord(nop(n,k-1),1)+cord(nop(n,kk),1))/2.
                  cord(n1,2)=(cord(nop(n,k-1),2)+cord(nop(n,kk),2))/2.
                  XUSR(n1) = CORD(n1,1) 
                  YUSR(n1) = CORD(n1,2) 
                  INSKP(n1)=0 
                  INEW(n1) = 1 
                  NP = MAX(NP,n1) 
                endif
              ENDIF
              if(inew(nop(n,k-1)) .eq. 0) then
                CALL EltERRDisp(n,ims)
                if(ims .eq. 1) CALL DELTEL(n) 
                go to 120
              endif
            enddo
120         continue              
          endif
        endif
      enddo
      WRITE(90,*) 'INOUT-797  NCLM',NCLM

      WRITE(MESG,6010) NE
 6010 FORMAT(I7,' Nodes read from file')
	  CALL SYMBL(1.1,3.3,0.25,mesg,0.0,28)

      RETURN 
!                                                                       
      END                                           
!                                                                       
!****************************************************************       
!                                                                       
      SUBROUTINE RDMAP(IFIRST,IMPP,JSTT,KSTT) 
!                                                                       
!  Read in coordinates of map lines                                     
!                                                                       
      USE BLKMAP
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 
      DIMENSION   NTMP(9) 
      DIMENSION VALS(2000)
      INTEGER*8 II
!                                                                       

      INCLUDE 'TXFRM.COM'
!IPK MAY02       COMMON  /TXFRM/  XS, YS, TXSCAL 
!
      CHARACTER*80 ALIN,lind 
!ipk jan98      CHARACTER*1 IJNK                                        
      CHARACTER*1 ans 
      CHARACTER*32 ANS32
      CHARACTER*5 LAB1
      CHARACTER*9 LAB2
      CHARACTER*8 LAB3
      CHARACTER*12 LAB4
      CHARACTER*4 HEDR
! 
    5  continue
	                                                                         
       
	   ielvsw=0
!      IF (IFIRST .EQ. 0)  THEN 
         IF(IFIRST .EQ. 2) IMP=IMPP
         VOID = - 1.0E+10 
         VDX = -1.0E+9 
         CXO=VDX 
         CYO=VDX 
         DO 10  J=JSTT+1,MAXPL 
            CMAP(J,1) = VOID 
            CMAP(J,2) = VOID 
            XMAP(J) = VOID 
            YMAP(J) = VOID 
    9    CONTINUE 
   10    CONTINUE 
         write(90,*) 'maxpl in rdmap - 1 ',maxpl
!ipk jan98                                                              
         ylv=7.9 
         call clscrn 
!      ENDIF 
!                                                                       
!ipkfeb94 added logic                                                   
      if(imp .eq. 9) then 
!                                                                       
      I=0 
      J=0 
      K=1 
20    READ(IMP,'(A80)') ALIN 
      if(alin(1:5) .eq. 'NCOLS') THEN
        CALL RDESRI(alin,j,k)
        GO TO 98
      ENDIF
!ipk oct96 addition to identify first point                             
      KFIRST=0 
      I=I+1 
      IF(MOD(I,25) .EQ. 0) REWIND 90 
      WRITE(90,'(2i5,A65)') I,K,ALIN 
!ipk oct94 3 lines added                                                
      if(mod(i,2000) .eq. 0) then 
!ipk jan98      write(*,*) i,' map lines now processed'                      
        ylv=ylv-0.3 
        if(ylv .lt. 0.1) then 
          ylv=7.9 
          call clscrn 
        endif 
        write(lind,6010) i 
        call symbl                                                      &
     &     (1.1,ylv,0.20,LIND,0.0,80)                                   
      endif 
      DO KC=1,5
        IF(ALIN(KC:KC) .EQ. 'E'  .OR.  ALIN(KC:KC) .EQ. 'e') THEN 
          GO TO 98 
        ENDIF 
      ENDDO
      READ(ALIN,*) LINTYP(K),VALL
      valkp=vall 
      IF(K .GT. MAXLIN) THEN 
!ipk dec09        CALL SETD(23) 
!ipk jan98                                                              
!ipk dec09        WRITE(lind,*) 'Too many map lines.  increase maxlin in common' 
!ipk dec09        ylv=ylv-0.6 
!ipk dec09        if(ylv .lt. 0.1) then 
!ipk dec09          ylv=7.9 
!ipk dec09          call clscrn 
!ipk dec09        endif 
!ipk dec09        call symbl                                                      &
!ipk dec09     &     (1.1,ylv,0.20,LIND,0.0,80)                                   
!ipk dec09        WRITE(90,*) 'Too many map lines.  increase maxlin in common' 
!ipk jan98        WRITE(*,*) ' Press enter to exit'                     
!ipk jan98        READ(*,'(A)') IJNK                                    
!ipk dec09        WRITE(LIND,*) ' Press enter to exit' 
!ipk dec09        call symbl                                                      &
!ipk dec09     &     (1.1,ylv-0.3,0.20,lind,0.0,80)                               
!ipk dec09        ndig=1 
!ipk dec09        CALL GTCHARX(ANS,IJNK,5.0,4.0) 
!ipk dec09        CALL Quit_Pgm 
      
        MAXPLL=MAXPL
  	    call ADJUSTMAP(MAXPLL)
		MAXPL=MAXPLL
	    deallocate (CMAP,XMAP,YMAP,VAL,imap,NCRS)

	    allocate (CMAP(MAXPL,2),XMAP(MAXPL),YMAP(MAXPL),VAL(MAXPL))

  	    ALLOCATE (imap(maxpl),NCRS(MAXPL))

	    maxpts=maxpl
	    ifirst=0
	    rewind imp
	    go to 5

      ENDIF 
   21 CONTINUE 
      READ(IMP,'(A80)') ALIN
	  
!ipk sep05

	  do i=1,80
	    if(alin(i:i) .eq. char(9)) then
		  alin(i:i)=','
        endif
      enddo
	  
      I=I+1 
      IF(MOD(I,25) .EQ. 0) REWIND 90 
      WRITE(90,'(2i5,A65)') I,K,ALIN 
!ipk oct94 3 lines added                                                
      if(mod(i,10000) .eq. 0) then 
!ipk jan98      write(*,*) i,' map lines now processed'                      
      ylv=ylv-0.3 
      if(ylv .lt. 0.1) then 
        ylv=7.9 
        call clscrn 
      endif 
      write(lind,6010) i 
 6010 format(i8,' map points processed') 
           call symbl                                                   &
     &     (1.1,ylv,0.20,LIND,0.0,80)                                   
      endif 
      DO KC=1,5
        IF(ALIN(KC:KC) .EQ. 'E'  .OR.  ALIN(KC:KC) .EQ. 'e') THEN 
          GO TO 97 
        ENDIF 
      ENDDO
!ipk oct96 change to permit more line types                             
!ipk jan01      IF(LINTYP(K) .NE. 2  .and.  valkp .lt. -9998.) THEN 
!IPK APR03      IF(LINTYP(K) .NE. 2  .and. valkp .ne. 0.) THEN 
!IPK APR03        READ(ALIN,*)   CX, CY
!IPK APR03        vall=valkp
!IPK APR03      ELSE 
!IPK APR03        READ(ALIN,*)   CX, CY, VALL 
!IPK APR03      ENDIF 
      IF(LINTYP(K) .EQ. 2) THEN
        READ(ALIN,*)   CX, CY, VALL 
      ELSEIF(VALKP .LT. 9999.) THEN
        READ(ALIN,*)   CX, CY
        vall=valkp
      ELSEIF(VALKP .EQ. 9999.) THEN
        READ(ALIN,*)   CX, CY, VALL
      ENDIF              
!ipk oct96 addition to prevent test on first point                      
      if(kfirst .ne. 0) then 
        IF(CX .EQ. CXO  .AND.  CY .EQ. CYO) GO TO 21 
      else 
        kfirst=1 
      endif 
      IF(J .EQ. MAXPL) THEN 
        CALL SETD(23) 
!ipk jan98        WRITE(*,*) 'Too many map points.  increase maxpl in co
!ipk jan98        WRITE(90,*) 'Too many map points.  increase maxpl in c
!ipk jan98        WRITE(*,*) ' Press enter to exit'                     
!ipk jan98        READ(*,'(A)') IJNK                                    
!ipk jan98                                                              
!ipk dec09        WRITE(lind,6030) maxpl
!ipk dec09 6030 format ('Map point exceed',i10,' increase maxpl in common' )
!ipk dec09        ylv=ylv-0.6 
!ipk dec09        if(ylv .lt. 0.1) then 
!ipk dec09          ylv=7.9 
!ipk dec09          call clscrn 
!ipk dec09        endif 
!ipk dec09        call symbl                                                      &
!ipk dec09     &     (1.1,ylv,0.20,LIND,0.0,80)                                   
!ipk dec09        WRITE(90,6030) maxpl
!ipk jan98        WRITE(*,*) ' Press enter to exit'                     
!ipk jan98        READ(*,'(A)') IJNK                                    
!ipk dec09        WRITE(LIND,*) ' Press enter to exit' 
!ipk dec09        call symbl                                                      &
!ipk dec09     &     (1.1,ylv-0.3,0.20,lind,0.0,80)                               
!ipk dec09        ndig=1 
!ipk dec09        CALL GTCHARX(ANS,IJNK,5.0,4.0) 
!ipk dec09        CALL Quit_Pgm 
      
	  call ADJUSTMAP(MAXPL)
	  deallocate (CMAP,XMAP,YMAP,VAL,imap,NCRS)

	  allocate (CMAP(MAXPL,2),XMAP(MAXPL),YMAP(MAXPL),VAL(MAXPL))

	  ALLOCATE (imap(maxpl),NCRS(MAXPL))

	  maxpts=maxpl
	  
	  rewind imp
	  go to 5




      ENDIF 
      J=J+1 
      CMAP(J,1) = CX 
      CMAP(J,2) = CY 
      XMAP(J) = CX 
      YMAP(J) = CY 
      VAL(J) = VALL 
      CXO=CX 
      CYO=CY 
!                                                                       
      GOTO 21 
!                                                                       
   97 CONTINUE 
      J=J+1 
      K=K+1 
      GO TO 20 
   98 CONTINUE 
!ipk feb94                                                              
      klint=k-1 
      jlint=j 
!ipk feb94 end change                                                   
      J=J+1 
      
!IPK FEB03
      
      MAXPTS=J-2

      write(90,*) 'maxpts in rdmap - 2 ',maxpts,xmap(908)

!IPK FEB02 SCLAE NEW VALUES

      IF(IFIRST .EQ. 2) THEN
        IF(CMAP(MAXPTS,1) .GE. VDX) MAXPTS=MAXPTS+1
        DO  K=1,MAXPTS 
         IF (CMAP(K,1) .GT. VDX)  THEN 
           CMAP(K,1) =  (CMAP(K,1)+XS)/TXSCAL
           CMAP(K,2) =  (CMAP(K,2)+YS)/TXSCAL
         ENDIF
        END DO 
      ENDIF
	  write(90,*) 'maxpts',maxpts
      CLOSE(IMP)
!	  do k=1,maxpts
!	  write(90,*) cmap(k,1),cmap(k,2),xmap(k),ymap(k),val(k)
!	  enddo
      RETURN 
      ELSEIF(IMP .EQ. 113) THEN
        CALL READSHP
!                                                                       
!                                                                       
!ipkfeb94 logic to add binary read of map                               
!                                                                       
      elseif(imp .eq. 92  .OR.  IMP .GT. 94) then 


!ipk jan98 test for max lines                                           
        read(imp) klint,jlint 
        rewind imp 
        if(klint+KSTT .gt. maxlin  .or. jlint +JSTT .gt. maxpl) then 
          call clscrn 
          write(lind,6310) 
 6310 format('   Compilation limits exceeded') 
          call symbl                                                    &
     &     (0.5,3.5,0.20,LIND,0.0,80)                                   
          write(lind,6311) maxpl,jlint 
 6311 FORMAT('   Maximum map points =',2i8,' points requested') 
          call symbl                                                    &
     &     (0.5,3.2,0.20,LIND,0.0,80)                                   
          write(lind,6312) maxlin,klint 
 6312 FORMAT(  '   Maximum lines =',2i8,' lines requested') 
          call symbl                                                    &
     &     (0.5,2.9,0.20,LIND,0.0,80)                                   
          WRITE(LIND,*) ' Press enter to exit' 
          call symbl                                                    &
     &     (0.5,2.0,0.20,lind,0.0,80)                                   
          ndig=1 
          CALL GTCHARX(ANS32,IJNK,5.0,4.0) 
          CALL Quit_Pgm 
          STOP 
        endif 
        read(imp) klint,jlint,(xmap(j),ymap(j),val(j),j=JSTT+1,JSTT+jlint)        &
     &           ,(lintyp(k),k=KSTT+1,KSTT+klint) 
	    read(imp,end=200) nelts ,((nopel(j,k),k=1,3),j=1,nelts)
		maxpts=jlint+JSTT
		go to 220
  200   continue
        MAXPTS=JLINT+JSTT
        nelts=0
  220   continue				
        do j=JSTT+1,JSTT+jlint 
          cmap(j,1)=xmap(j) 
          cmap(j,2)=ymap(j) 
        enddo 
        JLINT=MAXPTS
        KLINT=KSTT+klint
      ELSEIF(IMP .EQ. 94) THEN
       READ(IMP,'(A4)') HEDR
       IF(HEDR .EQ. 'DSAA') THEN
        READ(IMP,*) NCOLS1,NROWS1
        maxpts=ncols1*nrows1
        if(maxpts .gt. maxpl) then
          maxpl=maxpts+1
          deallocate (CMAP,XMAP,YMAP,VAL,imap,NCRS)

	      allocate (CMAP(MAXPL,2),XMAP(MAXPL),YMAP(MAXPL),VAL(MAXPL))

	      ALLOCATE (imap(maxpl),NCRS(MAXPL))
  
        endif
        READ(IMP,*) XXORG,XXTOP,YYORG,YYTOP
        READ(IMP,*) DD1,DD2
        DXINT=(XXTOP-XXORG)/(NCOLS1-1)
        DYINT=(YYTOP-YYORG)/(NROWS1-1)
        JJ=0
        II=0
        ANODAT=1.E36
        READ(IMP,*) (VAL(I),I=1,MAXPTS)
        DO J=NROWS1,1,-1
          DO I=1,NCOLS1
            II=II+1
            IF(VAL(II) .GT. ANODAT) CYCLE
            JJ=JJ+1
            XMAP(JJ)=DXINT*(I-1)+XXORG
            YMAP(JJ)=DYINT*(NROWS1+1-J)+YYORG
            CMAP(JJ,1)=XMAP(JJ)
            CMAP(JJ,2)=YMAP(JJ)
            VAL(JJ)=VAL(II)
          ENDDO
        ENDDO
        
       ELSE
        REWIND IMP
        READ(IMP,*) LAB1,NCOLS1
        READ(IMP,*) LAB1,NROWS1
        maxpts=ncols1*nrows1
        if(maxpts .gt. maxpl) then
          maxpl=maxpts+1
          deallocate (CMAP,XMAP,YMAP,VAL,imap,NCRS)

	      allocate (CMAP(MAXPL,2),XMAP(MAXPL),YMAP(MAXPL),VAL(MAXPL))

	      ALLOCATE (imap(maxpl),NCRS(MAXPL))
  
        endif
        READ(IMP,*) LAB2,XXORG
        READ(IMP,*) LAB2,YYORG
        READ(IMP,*) LAB3,CELLSIZ
        READ(IMP,*) LAB4,ANODAT
        JJ=0
        II=0
          READ(IMP,*) (VAL(I),I=1,MAXPTS)
          DO J=1,NROWS1
!          READ(IMP,*) (VALS(I),I=1,NCOLS1)
           DO I=1,NCOLS1
            II=II+1
            IF(VAL(II) .EQ. ANODAT) CYCLE
            JJ=JJ+1
            XMAP(JJ)=CELLSIZ*(I-1)+XXORG
            YMAP(JJ)=CELLSIZ*(NROWS1+1-J)+YYORG
            CMAP(JJ,1)=XMAP(JJ)
            CMAP(JJ,2)=YMAP(JJ)
            VAL(JJ)=VAL(II)
           ENDDO
          ENDDO
        ENDIF
        MAXPTS=JJ
        XMAP(MAXPTS+1)= VOID 

        KLINT=1
        LINTYP(1)=2
      else

!     READ AN RM1 FILE AS A MAP FILE

!     first headers
        jlint=0
        READ(IMP,'(a80)') alin
        READ(IMP,5010) IPP,nnrl8
 5010   FORMAT( 30x,i5,60x,i10) 
        READ(IMP,'(a80)') alin
        IF(IPP .GT. 0) READ(IMP,'(a80)') ALIN 

!     next elements

  230 CONTINUE
        read(imp,'(a80)',end=300) ALIN 

        IF(ALIN(6:20) .EQ. '               ') GO TO 250
		if(mod(nnrl8,2) .eq. 0) then
          READ(ALIN,'(10I5)',END=250)  J, (NTMP(K),K=1,9)       
        else
          READ(ALIN,'(10I6)',END=250)  J, (NTMP(K),K=1,9)                
	    endif
        NOPEL(J,1)=NTMP(1)
		NOPEL(J,2)=NTMP(3)
		NOPEL(J,3)=NTMP(5)
		NELTS=MAX(J,NELTS)
		GO TO 230

!     finally nodes
  250   CONTINUE
        read(imp,'(a80)',end=300) ALIN 
        if(ALIN(11:30) .eq. '                    ') go to 300
        if(nnrl8 .lt. 2) then
          READ(alin,'(I10,3F10.0)')  J, CX, CY,BELEV
                    
        else
          READ(alin,'(I10,2f20.0,F10.0)')  J, CX, CY, BELEV

        endif 
		xmap(j)=cx
		CMAP(J,1)=CX
		ymap(j)=cy
		CMAP(J,2)=CY
		val(j)=belev
		jlint=max(j,jlint)

		GO TO 250

  300   maxpts=jlint
        klint=1
		lintyp(1)=2
      ENDIF

!IPK FEB02 SCALE NEW VALUES

      IF(IFIRST .EQ. 2) THEN
        DO  K=JSTT+1,MAXPTS 
         IF (CMAP(K,1) .GT. VDX)  THEN 
           CMAP(K,1) =  (CMAP(K,1)+XS)/TXSCAL
           CMAP(K,2) =  (CMAP(K,2)+YS)/TXSCAL
         ENDIF
        END DO 
      ENDIF
      CLOSE(IMP)
      return 
      END                                           
!                                                                       
!***********************************************************************
!                                                                       
      SUBROUTINE RDELEM(IUNIT) 
!                                                                       
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 
      INCLUDE 'BFILES.I90'
      CHARACTER*1 AA,ANS
      CHARACTER*32 ANS32
      CHARACTER*81 DLIN 
      CHARACTER*150 DLIN1
      CHARACTER*3 ID
!cipk aug00
      CHARACTER*80 LIND 
      CHARACTER*25 BLANK 
	  CHARACTER*31 MESG
      DIMENSION   NTMP(9),ATT(9)
!                                                                       
      DATA  IFIRST / 0 / 
      DATA  IERRL /0/ 
      DATA BLANK /'                         '/ 
!ipk jul94 add a line                                                   
      MEL=MAXE 
!cipk aug00
     ylv=7.5
!                                                                       
!  Read in existing elements                                            
!                                                                       
      IF (IFIRST .EQ. 0)  THEN 
!                                                                       
!  Initialize arrays                                                    
!                                                                       
         VOID = - 1.0E+10 
         VDX =  -1.E+9 
         IF(IIN .EQ. 10) NE = 0 
         IFIRST = 1 
      ENDIF 
	  ISTART=0
	  NTMP=0
	  ATT=0.
!                                                                       
      IF(IUNIT .EQ. 0) RETURN 
      IF(IUNIT .EQ. 10) THEN 

        IF(IGFG .GT. 0) REWIND IUNIT
        JZ=0
!ipk oct96 move around login to allow long length files                 
   10   CONTINUE 
        IF(IGFG .EQ. 0  .AND.  ITRIAN .EQ. 0) THEN 
          READ(IUNIT,'(A81)',END=98) DLIN 
!ipk mar04        IF(DLIN(6:20) .EQ. BLANK  .AND.  IERRL .EQ. 0) THEN 
          IF(DLIN(7:20) .EQ. BLANK  .AND.  IERRL .EQ. 0) THEN 
            GO TO 175 
!ipk dec97  generalize to allow multiple errors                         
!ipk dec97        ELSEIF(IERRL .EQ. 1) THEN                             
          ELSEIF(IERRL .EQ. 1  .and.  dlin(6:20) .eq. blank) THEN 
            CALL SETD(23) 
!cipk aug00
            WRITE(lind,6000) 
 6000       FORMAT(' Press enter to exit') 
            call symbl                                                      &
     &      (1.1,ylv-0.3,0.20,lind,0.0,80)                               
            ndig=1 
            CALL GTCHARX(ANS32,IJNK,5.0,4.0) 
            CALL Quit_Pgm 
            STOP 

          ENDIF 
          ifree=1
          do j=1,10
            if(dlin(j:j) .eq. ',') then
              ifree=0
            endif
          enddo
          if(ifree .eq. 1) then
		    if(mod(ntempin,2) .eq. 0) then
              READ(DLIN,'(10I5,F10.3,I5)',END=98)  J, (NTMP(K),K=1,9),THT     &
     &                                         ,NTEMP                   
            else
              READ(DLIN,'(10I6,F10.3,I6)',END=98)  J, (NTMP(K),K=1,9),THT     &
     &                                         ,NTEMP                   
	        endif
	      else
            READ(DLIN,*,END=98)  J, (NTMP(K),K=1,9),THT     &
     &                                         ,NTEMP                   
	      endif
		ELSEIF(ITRIAN .EQ. 1) THEN
		  IF(ISTART .EQ. 0) THEN
		    REWIND(IUNIT)
		    READ(IUNIT,*) NE,NCNTR,NATTR
			ISTART=1
		  ENDIF
		  READ(IUNIT,*) J,(NTMP(K),K=1,NCNTR),(ATT(K),K=1,NATTR)
          IF(J .EQ. 0) THEN
            JZ=1
            J=NE
          ENDIF
        ELSE
!ipk jun02 Allow for GFGEN input
          DO ICOUNTC=1,700000
            DO JJ=1,150
              DLIN1(JJ:JJ)=' '
            ENDDO
            READ(IUNIT,'(A3,A150)', END=175) ID,DLIN1
            IF(ID .EQ. 'GE ') 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
            ELSEIF(ID .EQ. 'E3T') THEN
              ICOUNT=4
              GO TO 90
            ELSEIF(ID .EQ. 'E4Q') THEN
              ICOUNT=5
              GO TO 90
            ENDIF
          ENDDO
   90     CONTINUE
          IF(ICOUNT .GT. 10) THEN
            READ(DLIN1,*) J, (NTMP(K),K=1,9),THT 
          ELSEIF(IGFG .EQ. 3) THEN
            IF(ICOUNT .EQ. 4) THEN
              READ(DLIN1,*) J, (NTMP(K),K=1,7,2)
              IF(NTMP(7) .EQ. 0) NTMP(9)=1
              NTMP(2)=0
              NTMP(4)=0
              NTMP(6)=0
              NTMP(7)=0
              NTMP(8)=0
            ELSEIF(ICOUNT .EQ. 5) THEN
              READ(DLIN1,*) J, (NTMP(K),K=1,9,2)
              IF(NTMP(9) .EQ. 0) NTMP(9)=1
              NTMP(2)=0
              NTMP(4)=0
              NTMP(6)=0
              NTMP(8)=0
            ENDIF
          ELSE
            READ(DLIN1,*) J, (NTMP(K),K=1,9)
          ENDIF
        ENDIF

!c        IF (J .GT. 9000  .AND.  IERRL .EQ. 0) THEN                    
!c          GO TO 175                                                   
!IPK OCT96 END CHANGES                                                  
        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 12 K=1,7 
          IF(NTMP(K) .EQ. 0) GO TO 12 
          DO 11 L=K+1,8 
            IF(NTMP(K) .EQ. NTMP(L)) THEN 
              CALL SETD(23) 
!cipk aug00
!              WRITE(90,5000) J
!              write(90,5001) (NTMP(MM),MM=1,8) 
!              WRITE(lind,5000) J
!              call symbl                                                      &
!     &        (1.1,ylv-0.3,0.25,lind,0.0,80)                               
!              ylv=ylv-0.3
!              if(ylv .lt. 0.4) then
!                call clscrn
!                ylv=7.5
!              endif
!              write(lind,5001) (NTMP(MM),MM=1,8) 
!              call symbl                                                      &
!     &        (1.1,ylv-0.3,0.25,lind,0.0,80)                               
!              ylv=ylv-0.3
!              if(ylv .lt. 0.4) then
!                call clscrn
!                ylv=7.5
!              endif
 5000 FORMAT(' **ERROR** Nodes at element number',i5,' are duplicated')
 5001 FORMAT(' node list as follows  ',8i5)                                       
!              IERRL=1 
              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 13
            ENDIF 
   11     CONTINUE 
   12   CONTINUE
   13   CONTINUE 
        IF(ITRIAN .EQ. 0) THEN
          DO 15  K=1,8 
            NOP(J,K) = NTMP(K) 
            ND = NTMP(K) 
            IF (ND .GT. 0) THEN 
              INEW(ND) = 2 
              NP = MAX(NP,ND) 
            ENDIF 
   15     CONTINUE 
          IMAT(J) = NTMP(9) 
          THTA(J)=0
          IEM(J) = j 
        ELSE
		  DO K=1,3
			NOP(J,2*K-1)=NTMP(K)
		    IF(NCNTR .EQ. 3) THEN
			  NOP(J,2*K)=0
            ELSEIF(NCNTR .EQ. 6) THEN
			  NOP(J,2*K)=NTMP(K+3)
			ENDIF
            ND = NTMP(K) 
            IF (ND .GT. 0) THEN 
              INEW(ND) = 2 
              NP = MAX(NP,ND) 
            ENDIF 
          ENDDO                                                              
 	  	  NOP(J,7)=0
          NOP(J,8)=0
		  IF(NATTR .GT. 0) THEN
		    IMAT(J)=ATT(1)+0.5
			IF(NATTR .GT. 1) THEN
			  THTA(J)=ATT(2)
			  IF(NATTR .GT. 2) THEN
			    IEM(J)=ATT(3)
			  ELSE
			    IEM(J)=0
              ENDIF
			ELSE
			  THTA(J)=0.
			  IEM(J)=0
            ENDIF
          ELSE
		    IMAT(J)=1
  	 	    THTA(J)=0.
		    IEM(J)=0
		  ENDIF
        ENDIF
        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 
        DO 25  K=2,NCN,2 
          ND = NTMP(K) 
          IF (ND .GT. 0) THEN 
            IF(NCN .EQ. 5  .AND.  K .EQ. 4) GO TO 25 
            WD(ND)=0. 
          ENDIF 
   25   CONTINUE
        IF(ITRIAN .EQ. 1) THEN
          IF((JZ .EQ. 0  .AND.  J .EQ. NE)  .OR.  (JZ .EQ. 1  .AND.  J .EQ. NE-1)) THEN
		    CLOSE(IUNIT)
  		    DO L=255,1,-1
		      IF(FNAMKEP(L:L) .EQ. '.') THEN
			    FNAMKEP(L+1:L+1)='n'
			    FNAMKEP(L+2:L+2)='o'
  	 	        FNAMKEP(L+3:L+3)='d'
		 	    FNAMKEP(L+4:L+4)='e'
		        OPEN(IUNIT,FILE=FNAMKEP,STATUS='OLD',ACTION='READ')
                IF(JZ .EQ. 1) THEN
                  READ(IUNIT,*) NPPP,NDUM,NATTR
                  REWIND(IUNIT)
                  DO J=1,NE
                    DO K=1,5,2
                      IF(NOP(J,K) .EQ. 0) NOP(J,K)=NPPP
                    ENDDO
                  ENDDO
                ENDIF
		        GO TO 175 
			  ENDIF
		    ENDDO
          ENDIF
        ENDIF
        NE = MAX(J,NE) 
!                                                                       
        GOTO 10 
!                                                                       
   98   CONTINUE 
      ELSE 
        IF(IUNIT .EQ. 11) THEN 
!IPK FEB03          READ(IUNIT) ((NOP(J,K),K=1,8),IMAT(J),THTA(J),J=1,NE) 
    
	      CALL RDRST(2,IUNIT)
        ENDIF 
        DO 140 J=1,NE 
          IF(IMAT(J) .EQ. 0) GO TO 140 
          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 
!         DO 125  K=2,NCN,2                                             
!           ND = NOP(J,K)                                               
!           IF (ND .GT. 0) THEN                                         
!             IF(NCN .EQ. 5  .AND.  K .EQ. 4) GO TO 125                 
!             WD(ND)=0.                                                 
!           ENDIF                                                       
! 125     CONTINUE                                                      
  140   CONTINUE 
      ENDIF 
!                                                                       
!  Set up junction counter array                                        
!                                                                       
  175 CONTINUE 
      DO 180 N=1,NP 
      IJUN(N)=0 
  180 END DO 
      DO 200 N=1,NE 
!ipkoct93        IF(IMAT(N) .GT. 900) THEN                              
        IF(IMAT(N) .GT. 900  .AND.  IMAT(N) .LT. 904) THEN 
          DO 190 K=1,NCORN(N)
		    IF(NOP(N,K) .GT. 0) THEN 
              IJUN(NOP(N,K))=K 
			ENDIF
  190     CONTINUE 
        ENDIF 
  200 END DO 
      WRITE(MESG,6010) NE
 6010 FORMAT(I7,' Elements read from file')
	  CALL SYMBL(1.1,4.3,0.25,mesg,0.0,31)
      RETURN 
      END                                           
      SUBROUTINE CHKCON(IREP)
	  USE WINTERACTER 
!                                                                       
!  Check connectivity of grid                                           
!                                                                       
!-                                                                      
      USE BLK1MOD
      USE BLK2MOD 
!      INCLUDE 'BLK1.COM' 
!      INCLUDE 'BLK2.COM' 
      CHARACTER*80 LIND
!                                                                       
      CHARACTER*1 ANS 
!      CHARACTER*60  STRELS                                             
!      DATA STRELS/' You have tried to save before executing "FILL"'/   
!                                                                       
!  Test to make sure fill has been executed.                            
!                                                                       
      IF(IREP .EQ. 1) GO TO 100 
      ylv=7.5
      IREP = 1 
      DO 70 N=1,NE 
        IF(IMAT(N) .GT. 0) THEN 
          DO 60 M=2,NCORN(N),2 
            IF(NOP(N,M) .EQ. 0  .AND.  IMAT(N) .NE. 999) THEN 
              CALL GETSVPN(ANS)
              IF(ANS .EQ. 'T'  .OR.  ANS .EQ. 't') THEN 
                IREP = 0 
!ipk nov97 add 0                                                        
                CALL PLOTOT(0) 
                CALL HEDR 
                RETURN 
              ELSEIF(ANS .EQ. 'S'  .OR.  ANS .EQ. 's') THEN 
!ipk nov97 add (0)                                                      
                CALL PLOTOT(0) 
                CALL HEDR 
                IREP = 1
				return
!				go to 100 
!ipk jun04                RETURN 
              ELSEIF(ANS .EQ. 'F'  .OR.  ANS .EQ. 'f') THEN 
!ipk aug02
                CALL FILM(0) 
                IREP = 1 
              ELSE 
                IREP = 2 
              ENDIF 
            ENDIF 
   60     CONTINUE 
        ENDIF 
   70 END DO 
  100 CONTINUE 


      IDUP=0
      call kcon(1)
	  do n=1,ne
	    if(imat(n) .lt. 900  .and.  imat(n) .gt. 0) then
		  ndup=0
	      do j=2,ncorn(n),2
		    if(nop(n,j) .eq. 0) go to 120
		    if(ndelm(nop(n,j)) .gt. 2) then
              ndup=ndup+1
			endif
		  enddo
		  if(ndup .eq. ncorn(n)/2) then
		    IDUP=1
	        write(90,*) '                                   DUPLICATE ELEMENT',n
		  endif
		endif
	  enddo

  120 continue

      IF(IDUP .EQ. 1) THEN 
!cipk aug00

        Call WMessageBox(1,3,0,'Duplicate elements have been found'//Char(13)//&
		  'See file MESSGEN.OUT for details'//'Press OK to continue save',&
		  'ERROR IN NETWORK!!') 
        IF(WinfoDialog(ExitButtonCommon) .eq. CommonOK) then
          CALL HEDR 
          CALL PLOTOT(0) 
          IREP = 1 
        ELSE		    
          IREP = 0 
          CALL HEDR 
!ipk nov97 add (0)                                                      
          CALL PLOTOT(0) 
          RETURN 
        ENDIF
	  endif

!                                                                       
!  Test for areas of each element                                       
!                                                                       
      INEG = 0 
      DO 250 N=1,NE 
        IF(IMAT(N) .GT. 0  .AND. NCORN(N) .GT. 5) THEN 
          J1=NOP(N,1) 
          J2=NOP(N,3) 
          J3=NOP(N,5) 
          AREA=(CORD(J2,1)-CORD(J1,1))*(CORD(J3,2)-CORD(J1,2))-         &
     &         (CORD(J3,1)-CORD(J1,1))*(CORD(J2,2)-CORD(J1,2))          
          IF(AREA .LT. 0.) THEN 
!            IF(INEG .EQ. 0) CALL CLSCRN 
!            CALL SETD(23) 
!cipk aug00
!            WRITE(lind,*) 'Negative area for element number',N 
            WRITE(90,*) '                              NEGATIVE AREA FOR ELEMENT NUMBER',N 
!            if(ylv .lt. 0.4) then
!              ylv=7.5
!              call clscrn
!            endif
!            call symbl                                                      &
!     &      (1.1,ylv-0.3,0.20,lind,0.0,80)                               
!            ylv=ylv-0.3
!            ndig=1 
            INEG = 1 
            GO TO 250 
          ENDIF 
          IF(NCORN(N) .EQ. 8) THEN 
            J1=NOP(N,3) 
            J2=NOP(N,5) 
            J3=NOP(N,7) 
            AREA=(CORD(J2,1)-CORD(J1,1))*(CORD(J3,2)-CORD(J1,2))-       &
     &           (CORD(J3,1)-CORD(J1,1))*(CORD(J2,2)-CORD(J1,2))        
            IF(AREA .LT. 0.) THEN 
!              IF(INEG .EQ. 0) CALL CLSCRN 
!              CALL SETD(23) 
!cipk aug00
!              WRITE(lind,*) 'Negative area for element number',N 
              WRITE(90,*) 'Negative area for element number',N 
!              if(ylv .lt. 0.4) then
!                ylv=7.5
!                call clscrn
!              endif
!              call symbl                                                      &
!     &        (1.1,ylv-0.3,0.20,lind,0.0,80)                               
!              ylv=ylv-0.3
!              ndig=1 
              INEG = 1 
            ENDIF 
          ENDIF 
        ENDIF 
  250 END DO
   
      IF(INEG .EQ. 1) THEN 
!cipk aug00

        Call WMessageBox(1,3,0,'Negative Areas have been found'//Char(13)//&
		  'See file MESSGEN.OUT for details'//'Press OK to continue save',&
		  'ERROR IN NETWORK!!') 

!        WRITE(lind,*) 'If you wish to terminate save enter (t)' 
!        if(ylv .lt. 0.7) then
!          ylv=7.5
!          call clscrn
!        endif
!        call symbl                                                      &
!     &        (1.1,ylv-0.3,0.20,lind,0.0,80)                               
!        ylv=ylv-0.3
!        WRITE(lind,*) 'If you still wish to save     enter (s)' 
!        call symbl                                                      &
!     &        (1.1,ylv-0.3,0.20,lind,0.0,80)                               

!ipk jun96 change * to (a)                                              

!cipkaug00        READ(*,'(A)') ANS 
!        READ(*,*) ANS                                                  
!        CALL GTCHARX(ANS,IJNK,5.0,4.0) 

!        CALL SETD(2) 
!        IF(ANS .EQ. 'T'  .OR.  ANS .EQ. 't') THEN 
        IF(WinfoDialog(ExitButtonCommon) .eq. CommonOK) then
          CALL HEDR 
          CALL PLOTOT(0) 
          IREP = 1 
          RETURN 
        ELSE		    
          IREP = 0 
          CALL HEDR 
!ipk nov97 add (0)                                                      
          CALL PLOTOT(0) 
          RETURN 
        ENDIF
!        ELSEIF(ANS .EQ. 'S'  .OR.  ANS .EQ. 's') THEN 
!          CALL HEDR 
!ipknov97 add (0)                                                       
!          CALL PLOTOT(0) 
!          IREP = 1 
!          RETURN 
!        ENDIF 
      ENDIF 

      RETURN 
      END                                           
!ipk oct98 update call
      SUBROUTINE WRTMAP(isw) 
!                                                                       
!  Write map file in binary format                                      
!                                                                       
      USE BLKMAP
      USE BLK1MOD
      USE BLK2MOD 
!      INCLUDE 'BLK1.COM' 
!      INCLUDE 'BLK2.COM'
      character*3 ends
!                                                                       
!                                                                       
!  Open binary map file                                                 
!                                                                       
      IF(ISW .GT. 90) THEN
        IMPF=ISW
      ELSE
        impf=93
      ENDIF
      
!ipk oct98                                                              
      if(isw .eq. 0) then 
        OPEN(IMPF ,FILE=mpnam,STATUS='unknown',form='unformatted')
!IPK FRB03
      else 
	    rewind impf 
      endif

      if(isw .eq. 2) then
        impf=94 
        aninin=-9999.
        zero=0.
        ends='END'
        if(lintyp(1) .eq. 0  .or. lintyp(1) .eq. 1) then
          write(impf,*) lintyp(1),aninin
          ifm=1
        elseif(lintyp(1) .eq. 2) then
          write(impf,*) lintyp(1),zero
          ifm=2
        else
          write(impf,*) lintyp(1),val(1)
          ifm=1
        endif
        ilin=1
        do J=1,maxpts
          if(xmap(J) .gt. vdx) then
            if(ifm .eq. 1) then
              write(impf,*) xmap(j),ymap(j)
            else
              write(impf,*) xmap(j),ymap(j),val(j)
            endif
            if(j .eq. maxpts) write(impf,'(a3)') ends
          else
            write(impf,'(a3)') ends
            ilin=ilin+1
            if(j .eq. maxpts) go to 200
            if(lintyp(ilin) .eq. 0  .or. lintyp(ilin) .eq. 1) then
              write(impf,*) lintyp(ilin),aninin
              ifm=1
            elseif(lintyp(ilin) .eq. 2) then
              write(impf,*) lintyp(ilin),zero
              ifm=2
            else
              write(impf,*) lintyp(ilin),val(j+1)
              ifm=1
            endif
          endif

        enddo
  200   continue
        write(impf,'(a3)') ends
        return
      endif
      jlint=maxpts 
      write(impf) klint,jlint,(xmap(j),ymap(j),val(j),j=1,jlint)        &
     &           ,(lintyp(k),k=1,klint)                                 

      if(nelts .gt. 0) then
	    write(impf) nelts,((nopel(j,k),k=1,3),j=1,nelts)
	  endif
      return 
      END

      SUBROUTINE GETSVPN(ANS)

      use winteracter

      implicit none

      include 'D.inc'

!
! Declare window-type and message variables
!
      TYPE(WIN_STYLE)    :: WINDOW

      TYPE(WIN_MESSAGE) :: MESSAGE
      INTEGER           :: IPOS
      INTEGER           :: JNK,ierr
      CHARACTER*1       :: ANS,CDAT(4)
      DATA CDAT/'s','t','f','c'/
      call wdialogload(IDD_DIALOG07)
      ierr=infoerror(1)


      call wdialogputRadioButton(idf_radio1)


      CALL WDialogSelect(IDD_DIALOG07)
      ierr=infoerror(1)
 
      CALL WDialogShow(-1,-1,0,Modal)
      ierr=infoerror(1)
      

      do
         IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN

          call wdialoggetradiobutton(idf_radio1,ipos)
          ans=cdat(ipos)
          return
         endif
!IPK SEP02
	 ans=cdat(1)
	 return
      enddo
      RETURN
      END                                           

!***************************************************************************************

      subroutine wrtgfg(IOF)

      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 

      IOF=IOT
      WRITE(IOF,5000) TITLE 
 5000 format('T1'/'T2'/'T3    ',A80)
      WRITE(IOF,5001)
 5001 FORMAT('SI  1')
      WRITE(IOF,5002)
 5002 FORMAT('$L  3 0 6 0')
!
!     CURRENTLY DISABLED
!
!      IF(NLST .GT. 0) THEN 
!        DO J=1,NLST 
!          IF(LLIST(J) .GT. 0) THEN
!		    IF(J .EQ. 1) THEN
!			  ILIST(J,LLIST(J))=-ABS(ILIST(J,LLIST(J)))
!			ENDIF
!            WRITE(IOF,5003) (ILIST(J,I),I=1,LLIST(J)) 
! 5003 FORMAT('GO     2',11I6/('GO',12I6))
!          ENDIF 
!        ENDDO
!      ENDIF 
      DO J=1,NE 
        IF (IMAT(J) .NE. 0)  THEN 
          IF(IECHG .EQ. 0) IEM(J)=J 
          WRITE(IOF,5004)                                &
     &      J, (NOP(J,K),K=1,8), IMAT(J),THTA(J)
 5004         FORMAT('GE',10(1X,I6),F17.4)
        ENDIF 
      ENDDO
	  DO J=1,NP
        IF (INEW(J) .EQ. 1)  THEN 
            WRITE(IOF, 5005)                                          &
     &        J,XUSR(J),YUSR(J),WD(J)                                  
 5005     FORMAT('GNN',I6,2F14.3,F10.3)
        ENDIF
	  ENDDO
	  DO J=1,NP
        IF (INEW(J) .EQ. 1)  THEN 
          IF(WIDTH(J) .GT. 0.) THEN
            WRITE(IOF, 5006)                                          &
     &        J,                                  &
     &        WIDTH(J),SS1(J),SS2(J),WIDS(J)                            
 5006       FORMAT('GWN',I6,1X,F9.1,1X,2F6.2,1X,F9.1)
          ENDIF
        ENDIF
	  ENDDO


	  return
	  end

      subroutine wrtele(IOF,itr)

      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 

      IOF=IOT
	  NVRT=2
	  if(itr .eq. 1) then
        NEL=NE
  	    NATT=2
		IF(NOP(1,2) .EQ. 0) THEN
	      NVRT=3
	    ELSE
	      NVRT=6
	    ENDIF 
	    write(IOF,6001) NEL,NVRT,NATT
		DO N=1,NE
		  IF(NVRT .EQ. 3) THEN
		    WRITE(IOF,6002) N,(NOP(N,J),J=1,5,2),IMAT(N),THTA(N)
		  ELSE
		    WRITE(IOF,6003) N,(NOP(N,J),J=1,5,2),(NOP(N,J),J=2,6,2),IMAT(N),THTA(N)
          ENDIF
		ENDDO
 	  else
	    NPL=NP
		NATT=1
	    write(IOF,6001) NPL,NVRT,NATT
		DO N=1,NPL
          WRITE(IOF,6004) N,XUSR(N),YUSR(N),WD(N)
		ENDDO

	  endif
 6001 FORMAT(I6,I2,I2,I2)
 6002 FORMAT(I6,3(' ',I6),I5,' ',F6.2)
 6003 FORMAT(I6,6(' ',I6),I5,' ',F6.2)
 6004 FORMAT(I6,2F16.6,F11.4)
	  return
	  end


      SUBROUTINE RDRST(IENT,IUNIT)

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

      IF(IENT .EQ. 1) THEN
!        READ(IUNIT) IDUMMY1
        READ(IUNIT) TITLE,NP,NE
!        READ(IUNIT) IDUMMY1,IDUMMY2
        READ(IUNIT) ISLP,IPRT,IPNN,IPEN,IPO,IRO,IPP,IRFN              &
     &  ,IGEN,NXZL,NITST,ISCTXT,IFILL,IALTGM,NLAYD,xadded,yadded,ntempin                      
!        READ(IUNIT) ,IDUMMY2,IDUMMY3
        READ(IUNIT) HORIZ,VERT,XSALE,YSALE,XFACT,YFACT,AR,ANG 
        IPP=0
        NTEMPIN=2
        IF(IPP .GT. 0) THEN
!          READ(IIN) IDUMMY3,IDUMMY4
          READ(IIN) ALINE 
        ENDIF

      ELSEIF(IENT .EQ. 2) THEN
!        READ(IUNIT) IDUMMY4,IDUMMY5
        READ(IUNIT) ((NOP(J,K),K=1,8),IMAT(J),THTA(J),J=1,NE) 
        DO J=1,NE 
          IF(IMAT(J) .NE. 0) THEN
            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 
          ENDIF
		ENDDO
	  ELSE

!        READ(IUNIT) IDUMMY5,IDUMMY6
        READ(IUNIT)                                                   &
     &   (XUSR(J),YUSR(J),WD(J),WIDTH(J),SS1(J),SS2(J),WIDS(J),         &
     &    WIDBS(J),SSO(J),BS1(J),J=1,NP)                                       
        DO J=1,NP 
          CORD(J,1) = XUSR(J) 
          CORD(J,2) = YUSR(J) 
          INSKP(J)=0
		  INEW(J)=0 
          IF (CORD(J,1) .GT. VDX)  THEN 
            INEW(J) = 1 
          ENDIF 
		ENDDO
!        READ(IUNIT) IDUMMY5,IDUMMY6
        READ(IUNIT) NLST 
        IF(NLST .GT. 0) THEN 
!          READ(IUNIT) IDUMMY5,IDUMMY6            
          READ(IUNIT) (LLIST(J),J=1,NLST),                            &
          ((ILIST(J,I),I=1,LLIST(J)),J=1,NLST)                        
        ENDIF 

!        READ(IUNIT) IDUMMY5,IDUMMY6
        READ(IUNIT) NENTRY,NLAYD,NCLM
        if(nentry .eq. 0 .and. nlayd .eq. 0  .and. nclm .eq. 0) return
!        READ(IUNIT) IDUMMY5,IDUMMY6        
        IF(NENTRY .GT. 0) THEN 
!          READ(IUNIT) IDUMMY5,IDUMMY6
          READ(IUNIT) ((NEF(I,J),J=1,3),I=1,NENTRY) 
        ENDIF 
        IF(NLAYD .GT. 0) THEN 
!          READ(IUNIT) IDUMMY5,IDUMMY6
          READ(IUNIT) (LAY(I),I=1,NP),((WTLAY(I,J),J=1,9),I=0,NP) 
        ENDIF 
        IF(NCLM .GT. 0) THEN 
!          READ(IUNIT) IDUMMY5,IDUMMY6
!          NCLM=11
          READ(IUNIT) ((ICCLN(I,J),J=1,350),I=1,NCLM) 
        ENDIF 
	  ENDIF
	  RETURN
	  END

      SUBROUTINE ADJUSTMAP(MAXPLL)
!                                                                       
!  Generate continuity lines                                            
!                      

	  USE WINTERACTER
	  USE BLKMAP
      include 'd.inc'
                                                 
!
! Declare window-type and message variables
!
      TYPE(WIN_STYLE)    :: WINDOW

      TYPE(WIN_MESSAGE) :: MESSAGE

      integer  :: NTYP,NLOCC


      call wdialogload(IDD_SETMAXMAP)
      ierr=infoerror(1)

      CALL WDialogSelect(IDD_SETMAXMAP)
      ierr=infoerror(1)

      CALL WDialogPutINTEGER(IDF_INTEGER1,MAXPLL)
      
	  CALL WDialogShow(-1,-1,0,Modal)
      ierr=infoerror(1)

      do
!
          IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN

           CALL WDialogGetINTEGER(IDF_INTEGER1,MAXPLL)

            GO TO 100
		  ENDIF

      enddo

  100 CONTINUE
      return
	  end

      SUBROUTINE RDESRI(alin,k,j)
      use blkmap
      use blk1mod
      real*8 xorig,yorig,cellsize
      character*80 alin
!   READ HEADERS
      read(alin(6:80),*) ncols
      READ(IMP,'(A80)') ALIN
      read(alin(6:80),*) nrows
      READ(IMP,'(A80)') ALIN
      read(alin(10:80),*) xorig
      READ(IMP,'(A80)') ALIN
      read(alin(10:80),*) yorig
      READ(IMP,'(A80)') ALIN
      read(alin(9:80),*) cellsize
      READ(IMP,'(A80)') ALIN
      read(alin(13:80),*) xnodat
      ntot=ncols*nrows
      read(imp,'(10f12.0)') (val(i),i=1,ntot)
      ict=0
      ikp=0
      do n=1,nrows
        ytemp=cellsize*(n-1)+yorig
        do m=1,ncols
          ict=ict+1
          if(val(ict) .ne. xnodat) then
            xtemp=cellsize*(m-1)+xorig
            ikp=ikp+1
            xmap(ikp)=xtemp
            ymap(ikp)=ytemp
            cmap(ikp,1)=xtemp
            cmap(ikp,2)=ytemp
            val(ikp)=val(ict)
          endif
        enddo
        LINTYP(1)=2
        k=2
        j=ikp
      enddo
      RETURN
      END