!     Last change:  IPK  12 Jan 98   11:21 am                           
!                                                                       
!****************************************************************       
!                                                                       
      SUBROUTINE ADDLAY 
!                                                                       
!  Add nodal layer data and write to file                               
!              
      USE BLK1MOD 
!      INCLUDE 'BLK1.COM' 
!                                                                       
      CHARACTER*1  IFLAG,ANSW(10) 
	  REAL  RLAY(9)
      DATA ANSW/' ',' ',' ',' ',' ',' ','n','z','r','q'/ 
!                                                                       
    4 CONTINUE 

      call  openlay

      NHTP=0 
      NBRR=0 
      NMESS=45
      CALL HEDR 
      NMESS=4 
      xprt=3.2 
!                                                                       
      IPOS=ILAYTP
      call GETLAYDAT(NLAY,ipos,RLAY)
	  ILAYTP=IPOS
!      call getint(nlay) 
!      READ(*,*)  NLAY                                                  
!                                                                       
!  Write out current layers                                             
!                                                                       
    7 CONTINUE 
      NHTP=0 
      NMESS=0 
      NBRR=4 
      CALL HEDR 
      CALL RCYAN 
      DO 10  K=1,NE 
        IF(IMAT(K) .GT. 0) THEN 
          IF(NCORN(K) .GT. 5) THEN 
            DO 9 N=1,NCORN(K),2 
              J=NOP(K,N) 
              FPN = LAY(J) 
              X = CORD(J,1) 
              Y = CORD(J,2) - .11 
              IF(X .GT. 0.  .AND.  X .LT. HSIZE  .AND.                   &
     &           Y .GT. 0.  .AND.  Y .LT. 7.0) THEN                     
                   CALL NUMBR(X,Y,0.2,FPN,0.0,-1) 
              ENDIF 
    9       CONTINUE 
          ENDIF 
        ENDIF 
   10 END DO 
      CALL RBLUE 
!                                                                       
!  Input new layers                                                     
!                                                                       
    5 IBOX=1 
      CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX) 

      IF(IRMAIN .EQ. 1) THEN
        REWIND 102
        DO J=1,NP
          IF(LAY(J) .GT. -9998) THEN
            if(ILAYTP .eq. 1) then
              write(102,6000) J,LAY(J),(WTLAY(J,I),I=1,LAY(J))
  6000        format('LD2     ',2i8,9F8.2)
            else
              write(102,6001) J,LAY(J),(WTLAY(J,I),I=1,LAY(J))
  6001        format('LD3     ',2i8,9F8.2)
            endif
          ENDIF
        ENDDO
        RETURN
      ENDIF
!                                                                       
      IF(IFLAG .EQ. 'c'  .AND. IBOX .GT. 0) THEN 
        IFLAG=ANSW(IBOX) 
      ENDIF 
      IF(IFLAG .EQ. 'n') THEN 
        GO TO 4 
      ELSEIF(IFLAG .EQ. 'q') THEN 
        NLAYD=1 
        REWIND 102
        DO J=1,NP
          IF(LAY(J) .GT. -9998) THEN
            if(ILAYTP .eq. 1) then
              write(102,6000) J,LAY(J),(WTLAY(J,I),I=1,LAY(J))
            else
              write(102,6001) J,LAY(J),(WTLAY(J,I),I=1,LAY(J))
            endif
          ENDIF
        ENDDO
        CALL WRTOUT(0) 
        RETURN 
      ENDIF 
!                                                                       
      XPRT=XPRT+0.5 
      IF(XPRT .GT. HSIZE) XPRT=0. 
      FPN= INODE 
      CALL NUMBR(XPRT,7.20,0.2,FPN,0.0,-1) 
      IF (IFLAG .EQ. 'c')  THEN 
         LAY(INODE) = NLAY 
         DO J=1,7
		   WTLAY(INODE,J)=RLAY(J)
		 ENDDO
         FPN = NLAY 
         X = CORD(INODE,1) 
         Y = CORD(INODE,2) + .11 
         CALL RRED 
         CALL NUMBR(X,Y,0.2,FPN,0.0,-1) 
         CALL RBLUE
!                                                                       
      ELSEIF(IFLAG .EQ. 'a') THEN 
        DO 100 K=1,NE 
          IF(IMAT(K) .GT. 0) THEN 
            IF(NCORN(K) .GT. 5) THEN 
              DO 90 N=1,NCORN(K),2 
                J=NOP(K,N) 
                DO I=1,7
	   	          WTLAY(J,I)=RLAY(I)
		        ENDDO
                LAY(J)=NLAY 
                FPN=NLAY 
                X = CORD(J,1) 
                Y = CORD(J,2) + .11 
                IF(X .GT. 0.  .AND.  X .LT. HSIZE  .AND.                 &
     &             Y .GT. 0.  .AND.  Y .LT. 7.0) THEN                   
                  CALL RRED 
                  CALL NUMBR(X,Y,0.2,FPN,0.0,-1) 
                  CALL RBLUE 
                ENDIF 
   90         CONTINUE 
            ENDIF 
          ENDIF 
  100   CONTINUE 
        NLAYD=1 
        CALL WRTOUT(0) 
      ELSEIF(IFLAG .EQ. 'f') THEN 
        DO 120 K=1,NE 
          IF(IMAT(K) .GT. 0) THEN 
            IF(NCORN(K) .GT. 5) THEN 
              DO 110 N=1,NCORN(K),2 
                J=NOP(K,N) 
                IF(LAY(J) .EQ. -9999.) THEN 
                  LAY(J)=NLAY 
                  DO I=1,7
  	      	        WTLAY(J,I)=RLAY(I)
		          ENDDO
                  FPN=NLAY 
                  X = CORD(J,1) 
                  Y = CORD(J,2) + .11 
                  IF(X .GT. 0.  .AND.  X .LT. HSIZE  .AND.               &
     &               Y .GT. 0.  .AND.  Y .LT. 7.0) THEN                 
                    CALL RRED 
                    CALL NUMBR(X,Y,0.2,FPN,0.0,-1) 
                    CALL RBLUE 
                  ENDIF 
                ENDIF 
  110         CONTINUE 
            ENDIF 
          ENDIF 
  120   CONTINUE 
        NLAYD=1 
        CALL WRTOUT(0) 
!                                                                       
      ELSE 
!ipk jan98         WRITE(*,*)  CHAR(7),CHAR(7)                          
      ENDIF 
!                                                                       
      GOTO 5 
!                                                                       
      END                                           
      subroutine openlay
      use winteracter

      implicit none

      include 'd.inc'
      CHARACTER(LEN=255)  :: FNAME
      CHARACTER(LEN=3)    :: SUB
      LOGICAL             :: OPENED
      INTEGER             :: IERR

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

      TYPE(WIN_MESSAGE) :: MESSAGE

      INQUIRE(102, OPENED=OPENED)
      if(.not. opened) then
        CALL WSelectFile(ID_STRING9,SaveDialog+PromptOn,FNAME,'Save layer file')
 
        IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN

          SUB='lay'
          CALL ADDSUB(FNAME,SUB)
          open(102,file=fname, form='formatted', status='unknown')
        ENDIF
      endif

      RETURN
      END

      SUBROUTINE RDLAYER
!                                                                       
!  Read nodal layer data                               
!                                                                       
      USE BLK1MOD 
!      INCLUDE 'BLK1.COM' 
      CHARACTER*8 ID
      CHARACTER*72 DLIN
	  DIMENSION WTTEMP(7)
     
!     
  100 CONTINUE
      READ(103,7000,END=400) ID,DLIN                             
 7000 FORMAT(A8,A72)
      IF(ID(1:2) .EQ. 'LD') THEN
        READ(DLIN,5000) NODNUM,NLAYD,(WTTEMP(I),I=1,7)
 5000   FORMAT(2I8,7F8.0)
        IF(NODNUM .EQ. 0) THEN
          DO N=0,NP
            LAY(N)=NLAYD
		    IF(NLAYD .GT. 0) THEN
		      DO I=0,NLAYD
			    WTLAY(N,I)=WTTEMP(I)
			  ENDDO
		    ENDIF 
          ENDDO
        ELSEIF(NODNUM .GT. 0) THEN
          LAY(NODNUM)=NLAYD
		  IF(NLAYD .GT. 0) THEN
		    DO I=1,NLAYD
			  WTLAY(NODNUM,I)=WTTEMP(I)
			ENDDO
		  ENDIF 

        ENDIF
      ENDIF
	  IF(ID(3:3) .EQ. '2') THEN
	    ILAYTP=1 
	  ELSE
	    ILAYTP=0
	  ENDIF
      GO TO 100
  400 CONTINUE
      DO K=1,NE 
        IF(IMAT(K) .GT. 0) THEN
          NCN=NCORN(K) 
          IF(NCN .EQ. 5) NCN=3
          DO N=1,NCORN(K),2 
            J=NOP(K,N) 
            FPN=LAY(N) 
            X = CORD(J,1) 
            Y = CORD(J,2) + .11 
            IF(X .GT. 0.  .AND.  X .LT. HSIZE  .AND.                 &
   &           Y .GT. 0.  .AND.  Y .LT. 7.0) THEN                   
              CALL RRED 
              CALL NUMBR(X,Y,0.2,FPN,0.0,-1) 
              CALL RBLUE 
            ENDIF 
          ENDDO
        ENDIF 
      ENDDO
      RETURN
      END
          
      SUBROUTINE WRTLAYER
      use winteracter

!                                                                       
!  Read nodal layer data                               
!                                                                       
      USE BLK1MOD 
!      INCLUDE 'BLK1.COM' 
      CHARACTER*8 ID
      CHARACTER*72 DLIN
	  DIMENSION WTTEMP(7)
      LOGICAL             :: OPENED
      include 'd.inc'
      CHARACTER(LEN=255)  :: FNAME
      CHARACTER(LEN=3)    :: SUB

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

      TYPE(WIN_MESSAGE) :: MESSAGE

      INQUIRE(102, OPENED=OPENED)
      if(.not. opened) then
        CALL WSelectFile(ID_STRING9,SaveDialog+PromptOn,FNAME,'Save layer file')
 
        IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN

          SUB='lay'
          CALL ADDSUB(FNAME,SUB)
          open(102,file=fname, form='formatted', status='unknown')
        ENDIF
	  else
	    rewind 102
      endif
 
      DO J=0,NP
          IF(LAY(J) .GT. -9998) THEN
		    if(j .gt. 0) then
			  if(lay(j)  .ne.  lay(0)) then
			    go to 300
			  else  
			    do i=1,lay(j)
				  if(wtlay(j,i) .ne. wtlay(0,i)) then
				    go to 300
				  endif
				enddo
			  endif
			  go to 500
  300         continue
              if(ILAYTP .eq. 1) then
                write(102,6000) J,LAY(J),(WTLAY(J,I),I=1,LAY(J))
 6000           format('LD2     ',2i8,9F8.2)
              else
                write(102,6001) J,LAY(J),(WTLAY(J,I),I=1,LAY(J))
 6001           format('LD3     ',2i8,9F8.2)
              endif
			else
              if(ILAYTP .eq. 1) then
                write(102,6000) J,LAY(J),(WTLAY(J,I),I=1,LAY(J))
              else
                write(102,6001) J,LAY(J),(WTLAY(J,I),I=1,LAY(J))
              endif
		    endif
          ENDIF
 500    CONTINUE
        ENDDO
       RETURN
      END
