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.

129 lines
3.3 KiB
Fortran

MODULE BLKOUT
ALLOCATABLE XOUTL(:),YOUTL(:)
INTEGER NOUTLIN
ENDMODULE
SUBROUTINE RDOUTLIN
!
! ROUTINE TO READ COORDINATES OF MESH OUTLINE
USE WINTERACTER
USE BLKOUT
USE BLK1MOD
USE BLKMAP
INCLUDE 'BFILES.I90'
include 'TXFRM.COM'
CHARACTER(LEN=255) :: FNAME
! CHARACTER(LEN=3) :: SUB,SUB1
CHARACTER(LEN=256) :: FILTER
CHARACTER*3 SUB
FILTER ="Outline files -- *.txt,*.map,*.shp|*.txt;*.map;*.shp|txt files -- |*.txt|map files -- |*.map|Polygon shapefiles - *.shp|*.shp|All files -- |*.*|"
CALL WSelectFile(FILTER,PromptOn,FNAME,'Load Outline File')
IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
CALL IlowerCase(FNAME)
CALL GETSUB(FNAME,SUB)
IF(SUB .EQ. 'map') then
KTYP=2
OPEN(99,FILE=FNAME,STATUS='OLD')
ELSEIF(SUB .EQ. 'txt') then
KTYP=1
OPEN(99,FILE=FNAME,STATUS='OLD')
ELSE
KTYP=3
OPEN(99,FILE=FNAME,STATUS='OLD',form='binary')
ENDIF
ELSE
RETURN
ENDIF
IF(KTYP .EQ. 3) THEN
CALL RDSHP5(99)
ELSE
ALLOCATE (XOUTL(5000),YOUTL(5000))
IF(KTYP .EQ. 2) READ(99,*) INDM
DO N=1,5000
READ(99,*,END=500,ERR=500) XOUTL(N),YOUTL(N)
ENDDO
ENDIF
! Find max and min
!XMIN = 1.E+20
!XMAX = -XMIN
!YMIN = 1.E+20
!YMAX = -YMIN
!
!DO J=1,MAXPTS
! IF (CMAP(J,1) .LT. VDX) CYCLE
! IF (CMAP(J,1) .LT. XMIN) XMIN = CMAP(J,1)
! IF (CMAP(J,1) .GT. XMAX) XMAX = CMAP(J,1)
! IF (CMAP(J,2) .LT. YMIN) YMIN = CMAP(J,2)
! IF (CMAP(J,2) .GT. YMAX) YMAX = CMAP(J,2)
!ENDDO
!AMAP=(XMAX-XMIN)*(YMAX-YMIN)
!XSCALE = (XMAX-XMIN)/(hsize-0.5)
!YSCALE = (YMAX-YMIN)/6.5
!PSCALE = MAX(XSCALE,YSCALE)
!
!XAVE = (XMIN + XMAX) /2.0
!YAVE = (YMIN + YMAX) /2.0
!XMIN = XAVE - hsize/2.*PSCALE
!YMIN = YAVE - 3.5*PSCALE
!XMAX = XAVE + (hsize-0.5)/2.*PSCALE
!YMAX = YAVE + 3.25*PSCALE
IMP=99
close(99)
500 CONTINUE
NOUTLIN=N-1
RETURN
END
SUBROUTINE RDSHP5(IMP1)
use blkmap
USE BLK1MOD
include 'TXFRM.COM'
INTEGER STATUS,I1,I2,I3,I4,I5,I6,I7,I8,I9,NREC,NARS,ISTYP,J2,J3,J4,IADB(1000)
REAL*8 AXMN,AYMN,AXMX,AYMX,FZ,BXMN,BYMN,BXMX,BYMX
READ(IMP1) I1,I2,I3,I4,I5,I6,I7,I8,I9,AXMN,AYMN,AXMX,AYMX,FZ,FZ,FZ,FZ
READ(IMP1) NREC,NARS
READ(IMP1) ISTYP,BXMN,BYMN,BXMX,BYMX,J2,J3
READ(IMP1) (IADB(I),I=1,J2)
IF( .NOT. ALLOCATED(CMAP)) THEN
MAXPL=J3
ALLOCATE (CMAP(MAXPL,2),XMAP(MAXPL),YMAP(MAXPL),VAL(MAXPL))
ENDIF
IS=0
IP=2
LINTYP(IP-1)=0
DO I=1,J3
IF(I .GT. IADB(IP)) THEN
IS=IS+1
XMAP(IS)=VOID
YMAP(IS)=VOID
CMAP(IS,1)=VOID
CMAP(IS,2)=VOID
VAL(IS)=VOID
IP=IP+1
LINTYP(IP-1)=0
ENDIF
IS=IS+1
READ(IMP1) CMAP(IS,1),CMAP(IS,2)
XMAP(IS)=CMAP(IS,1)
YMAP(IS)=CMAP(IS,2)
CMAP(IS,1) = (CMAP(IS,1) + XS) /TXSCAL
CMAP(IS,2) = (CMAP(IS,2) + YS) /TXSCAL
VAL(IS)=-9999.
ENDDO
MAXPTS=IS+1
XMAP(MAXPTS)= VOID
JLINT=MAXPTS
KLINT=IP
RETURN
END