SUBROUTINE SAVESHP
!
!   ROUTINE TO SAVE NETWORK AS A SHAPEFILE
!

	  USE WINTERACTER 
      USE BLK1MOD
      
      REAL*8 XK(12),YK(12),DEP(12)
!   SAVE INFO TO A SCRATCH
      VOID = -1.E10

      Call WMessageBox(3,2,1,'Do you wish to save as a complex polygon'//Char(13)//&
     'shapefile containing all the network data'//'Press YES to accept',&
	 'CHOOSE SHAPEFILE TYPE -1- !!') 
      IF(WinfoDialog(ExitButtonCommon) .eq. CommonOK) then
  	    IOPTSV=1
        IOPTSVNOD=0
        IOPTSVEL=0
      ELSE
        IOPTSV=2
        Call WMessageBox(3,2,1,'Do you wish to save as a polygon'//Char(13)//&
        'shapefile containing network outline'//'Press YES to accept',&
	    'CHOOSE SHAPEFILE TYPE -2- !!') 
        IF(WinfoDialog(ExitButtonCommon) .eq. CommonOK) then
  	      IOPTSVEL=1
        ELSE
  	      IOPTSVEL=0
    	ENDIF
        Call WMessageBox(3,2,1,'Do you wish to save as a point'//Char(13)//&
        'shapefile containing bed levels'//'Press YES to accept',&
	    'CHOOSE SHAPEFILE TYPE -3- !!') 
        IF(WinfoDialog(ExitButtonCommon) .eq. CommonOK) then
  	      IOPTSVNOD=1
        ELSE
  	      IOPTSVNOD=0
    	ENDIF
	  ENDIF
      IF(IOPTSVEL .EQ. 1  .OR.  IOPTSV .EQ. 1) THEN
        OPEN(113,FORM='BINARY',STATUS='SCRATCH')
        DO N=1,NE
          IF(IMAT(N) .GT. 0) THEN
            NC=0
            IF(NCORN(N) .GT. 5) THEN
              DO KK=1,NCORN(N)+1
                K=MOD(KK,NCORN(N))
                IF(K .EQ. 0) K=NCORN(N)
                NODE=NOP(N,K)
                IF(NODE .GT. 0) THEN
                  NC=NC+1
                  XK(NC)=XUSR(NODE)
                  YK(NC)=YUSR(NODE)
                  DEP(NC)=WD(NODE)
                ENDIF
              ENDDO
              IMATT=IMAT(N)
              WRITE(113) N,IMATT,NC,(XK(K),YK(K),DEP(K),K=1,NC)
            !ELSEIF(NCORN(N) .EQ. 5) THEN
            !  DO K=1,5
            !    NODE=NOP(N,K)
            !    IF(NODE .GT. 0) THEN
            !      NC=NC+1
            !      XK(NC)=XUSR(NODE)
            !      YK(NC)=YUSR(NODE)
            !      DEP(NC)=WD(NODE)
            !    ENDIF
            !  ENDDO
            !  DO K=3,1,-1
            !    NODE=NOP(N,K)
            !    IF(NODE .GT. 0) THEN
            !      NC=NC+1
            !      XK(NC)=XUSR(NODE)
            !      YK(NC)=YUSR(NODE)
            !      DEP(NC)=WD(NODE)
            !    ENDIF
            !  ENDDO
            !  IMATT=IMAT(N)
            !  WRITE(113) N,IMATT,NC,(XK(K),YK(K),DEP(K),K=1,NC)
            ELSEIF(NCORN(N) .LT. 6  .AND.  (IMAT(N) .LT. 900  .OR.  IMAT(N) .GT. 903)) THEN
              NODE1=NOP(N,1)
              DO K=1,3
                NODE=NOP(N,K)
                IF(NODE .GT. 0) THEN
                  NC=NC+1
                  XK(NC)=XUSR(NODE)
                  YK(NC)=YUSR(NODE)
                  DEP(NC)=WD(NODE)
                ENDIF
              ENDDO
              IF(WIDTH(NODE) .GT. 0.) THEN
                eldir=atan2(YUSR(NOP(N,3))-YUSR(NOP(N,1)),XUSR(NOP(N,3))-XUSR(NOP(N,1))) 
                elnorm=eldir-1.5708
                NC=NC+1
                xK(NC)=XK(NC-1)+cos(elnorm)*WIDTH(NODE)/2. 
                yK(NC)=YK(NC-1)+sin(elnorm)*WIDTH(NODE)/2.
                NMID=0
                IF(NOP(N,2) .GT. 0) THEN
                  NMID=1
                  NC=NC+1
                  xK(NC)=XK(2)+cos(elnorm)*(WIDTH(NODE)+WIDTH(NODE1))/4. 
                  yK(NC)=YK(2)+sin(elnorm)*(WIDTH(NODE)+WIDTH(NODE1))/4.
                ENDIF
                NC=NC+1
                xK(NC)=XK(1)+cos(elnorm)*WIDTH(NODE1)/2. 
                yK(NC)=YK(1)+sin(elnorm)*WIDTH(NODE1)/2.
                NC=NC+1
                xK(NC)=XK(1)-cos(elnorm)*WIDTH(NODE1)/2. 
                yK(NC)=YK(1)-sin(elnorm)*WIDTH(NODE1)/2.
                IF(NMID .GT. 0) THEN
                  NC=NC+1
                  xK(NC)=XK(2)-cos(elnorm)*(WIDTH(NODE)+WIDTH(NODE1))/4. 
                  yK(NC)=YK(2)-sin(elnorm)*(WIDTH(NODE)+WIDTH(NODE1))/4.
                  NC=NC+1
                  xK(NC)=XK(3)-cos(elnorm)*WIDTH(NODE)/2. 
                  yK(NC)=YK(3)-sin(elnorm)*WIDTH(NODE)/2.
                  NC=NC+1
                  XK(NC)=XK(3)
                  YK(NC)=YK(3)
                ELSE
                  NC=NC+1
                  xK(NC)=XK(2)-cos(elnorm)*WIDTH(NODE)/2. 
                  yK(NC)=YK(2)-sin(elnorm)*WIDTH(NODE)/2.
                  NC=NC+1
                  XK(NC)=XK(2)
                  YK(NC)=YK(2)
                ENDIF
              ELSE    
                DO K=2,1,-1
                  NODE=NOP(N,K)
                  IF(NODE .GT. 0) THEN
                    NC=NC+1
                    XK(NC)=XUSR(NODE)
                    YK(NC)=YUSR(NODE)
                    DEP(NC)=WD(NODE)
                  ENDIF
                ENDDO
              ENDIF
              IMATT=IMAT(N)
              WRITE(113) N,IMATT,NC,(XK(K),YK(K),DEP(K),K=1,NC)
            ENDIF
          ENDIF
        ENDDO
        REWIND 113
            
!   CALL FORMSHP TO WRITE OUT SHAPEFILE
        IF(IOPTSV .EQ. 1) THEN
          ISTYP=25
!   ISTYP=25 is saving element list
          IVECACT=4
        ELSE
!   ISTYP=5 is saving element list with polygons?
          ISTYP=5
          IVECACT=5
        ENDIF
        CALL FORMSHP2(istyp,ivecact)
        CLOSE(113)
      ENDIF

      IF(IOPTSVNOD .EQ. 1) THEN
        OPEN(113,FORM='BINARY',STATUS='SCRATCH')
        DO NODE=1,NP
          IF(XUSR(NODE) .GT. VOID) THEN
            WRITE(113) NODE,XUSR(NODE),YUSR(NODE),WD(NODE)
          ENDIF
        ENDDO
        REWIND 113
!     ISTYP=1  is saving of nodal values            
        ISTYP=1
        IVECACT=6
        CALL FORMSHP2(istyp,ivecact)
        CLOSE (113)
      ENDIF
      
      RETURN
      END