You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
175 lines
5.6 KiB
Fortran
175 lines
5.6 KiB
Fortran
5 years ago
|
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
|