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.
1061 lines
33 KiB
Fortran
1061 lines
33 KiB
Fortran
|
|
! Last change: IPK 12 Jan 98 1:44 pm
|
|
!
|
|
SUBROUTINE GNODE
|
|
!
|
|
! Routine to create a series of nodes along a line
|
|
!
|
|
USE BLK1MOD
|
|
! INCLUDE 'BLK1.COM'
|
|
|
|
INCLUDE 'TXFRM.COM'
|
|
!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
|
|
|
|
REAL*8 GRIDX(150),GRIDY(150),ALX,ALY,ATX,ATY,ALXX(1000),ALYY(1000),ALWD(1000)
|
|
REAL*8 BLXX(1000),BLYY(1000),BLWD(1000),CURRENTX,CURRENTY
|
|
INTEGER ITYPBC(1000),IREF(1000)
|
|
!
|
|
CHARACTER*1 IFLAG
|
|
data itime/0/
|
|
|
|
if(itime .eq. 0) then
|
|
nh=1
|
|
itime=1
|
|
endif
|
|
4 CONTINUE
|
|
CALL FORMLINEMENU(ITYP,I1D,I2D,IFIN,XLENGTH,ITYPIN,NELC)
|
|
IF(I1D .EQ. -999) RETURN
|
|
IF(ITYP .EQ. 1) THEN
|
|
NHTP = 0
|
|
NMESS = 6
|
|
NBRR = 3
|
|
CALL HEDR
|
|
!
|
|
! Get screen coordinates of each end of line
|
|
!
|
|
7 CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
|
|
ALX=XTEMP
|
|
ALY=YTEMP
|
|
IF(IRMAIN .EQ. 1) RETURN
|
|
!
|
|
IF(IFLAG .EQ. 'q' .OR. (IFLAG .EQ. 'c' .AND. IBOX .EQ. 10))THEN
|
|
CALL WRTOUT(0)
|
|
RETURN
|
|
ENDIF
|
|
!
|
|
! Exit input
|
|
!
|
|
9 CONTINUE
|
|
CALL PLOTT(XTEMP,YTEMP,3)
|
|
CALL PLOTT(XTEMP,YTEMP,2)
|
|
CALL HEDR
|
|
!
|
|
CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
|
|
ATX=XTEMP
|
|
ATY=YTEMP
|
|
IF(IRMAIN .EQ. 1) RETURN
|
|
!
|
|
CALL PLOTT(XTEMP,YTEMP,3)
|
|
CALL PLOTT(XTEMP,YTEMP,2)
|
|
!
|
|
! Define number of nodes in a line
|
|
!
|
|
NBRR = 0
|
|
NMESS=45
|
|
CALL HEDR
|
|
NMESS = 7
|
|
call getint(nh)
|
|
! READ(*,*) NH
|
|
NINT=NH-1
|
|
!
|
|
! zero GRIDX and GRIDY to hold generated coordinates
|
|
!
|
|
DO N=1,NH
|
|
GRIDX(N)=0.
|
|
GRIDY(N)=0.
|
|
END DO
|
|
!
|
|
! Interpolate points onto line
|
|
!
|
|
CALL INTERP(GRIDX,GRIDY,1,NH,1,ALX,ALY,ATX,ATY,NINT,0)
|
|
!
|
|
! Copy points into the coordinate array
|
|
!
|
|
DO N=1,NH
|
|
!
|
|
! Find next blank node in CORD
|
|
!
|
|
CALL GETNOD(J)
|
|
!
|
|
! Store GRIDX and GRIDY into it
|
|
!
|
|
CORD(J,1) = GRIDX(N)
|
|
CORD(J,2) = GRIDY(N)
|
|
INEW(J) = 1
|
|
INSKP(J) = 0
|
|
!
|
|
XUSR(J) = GRIDX(N)*TXSCAL - XS
|
|
YUSR(J) = GRIDY(N)*TXSCAL - YS
|
|
!
|
|
! Display point
|
|
!
|
|
CALL PLTNOD(J,1)
|
|
!
|
|
END DO
|
|
ELSE
|
|
IF(IFIN .EQ. 0) THEN
|
|
NHTP = 0
|
|
NMESS = 6
|
|
NBRR = 3
|
|
CALL HEDR
|
|
!
|
|
! Get screen coordinates of each end of line
|
|
!
|
|
DO J=1,1000
|
|
CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
|
|
IF(IFLAG .EQ. 'q' .or. ibox .eq. 10) go to 300
|
|
ALXX(J)=XTEMP
|
|
ALYY(J)=YTEMP
|
|
JPTS=J
|
|
ENDDO
|
|
300 CONTINUE
|
|
ELSE
|
|
CALL FILEDAT(ALXX,ALYY,ALWD,JPTS,BLXX,BLYY,BLWD,JPTSB,ITYPBC)
|
|
ENDIF
|
|
! SORT OUT A NEW ORDER
|
|
|
|
IREF=1
|
|
CURRENTX=ALXX(1)
|
|
CURRENTY=ALYY(1)
|
|
KS=2
|
|
KSP=1
|
|
DO J=2,JPTS
|
|
DO K=KSP,JPTSB
|
|
TOTLEN=SQRT((ALXX(J)-CURRENTX)**2+(ALYY(J)-CURRENTY)**2)
|
|
TOTLENB=SQRT((BLXX(K)-CURRENTX)**2+(BLYY(K)-CURRENTY)**2)
|
|
IF(ABS(TOTLENB - TOTLEN) .LT. 1.0) THEN
|
|
! THIS IS A BREAKPOINT
|
|
IREF(KS)=-K
|
|
KS=KS+1
|
|
KSP=KSP+1
|
|
CURRENTX=BLXX(K)
|
|
CURRENTY=BLYY(K)
|
|
GO TO 320
|
|
ENDIF
|
|
IF(TOTLENB .LT. TOTLEN) THEN
|
|
! THIS IS A BREAKPOINT
|
|
IREF(KS)=-K
|
|
KS=KS+1
|
|
KSP=KSP+1
|
|
CURRENTX=BLXX(K)
|
|
CURRENTY=BLYY(K)
|
|
GO TO 310
|
|
ELSE
|
|
IREF(KS)=J
|
|
KS=KS+1
|
|
CURRENTX=ALXX(J)
|
|
CURRENTY=ALYY(J)
|
|
GO TO 320
|
|
ENDIF
|
|
310 CONTINUE
|
|
ENDDO
|
|
320 CONTINUE
|
|
ENDDO
|
|
IREF(KS)=JPTS
|
|
IF(IFIN .GT. 0) THEN
|
|
DO K=KS,1,-1
|
|
IF(IREF(K) .LT. 0) THEN
|
|
ALXX(K)=BLXX(-IREF(K))
|
|
ALYY(K)=BLYY(-IREF(K))
|
|
ALWD(K)=BLWD(-IREF(K))
|
|
WRITE(155,*) K,IREF(K),ALXX(K),ALYY(K)
|
|
ELSE
|
|
ALXX(K)=ALXX(IREF(K))
|
|
ALYY(K)=ALYY(IREF(K))
|
|
ALWD(K)=BLWD(IREF(K))
|
|
WRITE(155,*) K,IREF(K),ALXX(K),ALYY(K)
|
|
ENDIF
|
|
ENDDO
|
|
DO J=1,KS
|
|
ALXX(J)=(ALXX(J)+XS)/TXSCAL
|
|
ALYY(J)=(ALYY(J)+YS)/TXSCAL
|
|
ENDDO
|
|
DO J=1,KS
|
|
BLXX(J)=(BLXX(J)+XS)/TXSCAL
|
|
BLYY(J)=(BLYY(J)+YS)/TXSCAL
|
|
ENDDO
|
|
! KS=KS-1
|
|
ENDIF
|
|
JST=1
|
|
JKP=0
|
|
ICTYP=40
|
|
DO K=2,KS
|
|
IF(IREF(K) .LT. 0 .OR. K .EQ. KS) THEN
|
|
! IF(K .LT. KS) THEN
|
|
! IF(IREF(K) .LT. 0 .AND. IREF(K+1) .GT. 0) THEN
|
|
! ITYPB=ICTYP+1
|
|
! ICTYP=ICTYP+1
|
|
! ELSE
|
|
! ITYPB=ITYPIN
|
|
! ENDIF
|
|
! ELSE
|
|
! ITYPB=ITYPIN
|
|
! ENDIF
|
|
IF(MOD(K,2) .EQ. 0) THEN
|
|
ITYPB=ITYPIN
|
|
ELSE
|
|
ITYPB=ICTYP
|
|
ICTYP=ICTYP+1
|
|
ENDIF
|
|
IF(ITYPB .GT. 39) THEN
|
|
ICTT=(ITYPB-39)*2
|
|
ICTT=ITYPBC(ICTT)
|
|
ELSE
|
|
ICTT=0
|
|
ENDIF
|
|
JEND=K
|
|
XLENGTHP=XLENGTH
|
|
! GO AND FORM A LINE
|
|
CALL FORMLINEL(I1D,I2D,ALXX,ALYY,ALWD,JST,JEND,JKP,XLENGTHP,ITYPB,ICTT)
|
|
JST=JEND
|
|
ENDIF
|
|
ENDDO
|
|
ENDIF
|
|
|
|
IF(I2D .EQ. 1) CALL FORM999(1,1,NELC)
|
|
|
|
|
|
! GO TO 4
|
|
!
|
|
END
|
|
SUBROUTINE INTERP(GRIDX,GRIDY,NL,NH,INT,ALX,ALY,ATX,ATY,NINT,ISWT)
|
|
!
|
|
! Routine to fill GRIDX and GRIDY by interpolation
|
|
! NL = START OF GENERATED
|
|
! NH = END OF GENERATED
|
|
! INT = INTERVAL
|
|
! ALX, ALY = START LOC
|
|
! ATX, ATY = END LOC
|
|
! NINT = NUMBER OF POINTS
|
|
! ISWT = 0 BASELINE = 1 APPLY CHANGES
|
|
!IPK MAY02
|
|
REAL*8 GRIDX(NH),GRIDY(NH),ALX,ALY,ATX,ATY
|
|
!
|
|
! Compute intervals
|
|
!
|
|
XINT=(ATX-ALX)/FLOAT(NINT)
|
|
YINT=(ATY-ALY)/FLOAT(NINT)
|
|
!
|
|
! Generate points
|
|
!
|
|
IF(ISWT .EQ. 0) THEN
|
|
KP=0
|
|
DO 200 K=NL,NH,INT
|
|
IF(KP .EQ. 0) THEN
|
|
GRIDX(K)=ALX
|
|
GRIDY(K)=ALY
|
|
ELSE
|
|
GRIDX(K)=GRIDX(KP)+XINT
|
|
GRIDY(K)=GRIDY(KP)+YINT
|
|
ENDIF
|
|
KP=K
|
|
200 CONTINUE
|
|
ELSE
|
|
XAD=ALX
|
|
YAD=ALY
|
|
KP=0
|
|
DO 220 K=NL,NH,INT
|
|
IF(KP .EQ. 0) THEN
|
|
GRIDX(K)=GRIDX(K)+XAD
|
|
GRIDY(K)=GRIDY(K)+YAD
|
|
ELSE
|
|
XAD=XAD+XINT
|
|
YAD=YAD+YINT
|
|
GRIDX(K)=GRIDX(K)+XAD
|
|
GRIDY(K)=GRIDY(K)+YAD
|
|
ENDIF
|
|
KP=K
|
|
220 CONTINUE
|
|
ENDIF
|
|
RETURN
|
|
END
|
|
SUBROUTINE GEL
|
|
!
|
|
! Routine to create a block of elements
|
|
!
|
|
|
|
USE WINTERACTER
|
|
USE BLK1MOD
|
|
! INCLUDE 'BLK1.COM'
|
|
|
|
include 'd.inc'
|
|
|
|
|
|
INCLUDE 'TXFRM.COM'
|
|
!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
|
|
|
|
REAL*8 GRIDX,GRIDY,ALX,ALY,BLX,BLY,ARX,ARY,BRX,BRY,GRIDXL,GRIDYL
|
|
INTEGER*2 IGSKP
|
|
COMMON /GBLK/ GRIDX(MAXPGEN),GRIDY(MAXPGEN),GRIDXL(MAXPGEN),GRIDYL(MAXPGEN)&
|
|
,IGSKP(MAXPGEN),NRL,NRT,NYP,IGRIDE(MAXPGEN)
|
|
!
|
|
CHARACTER*1 IFLAG
|
|
data itime/0/
|
|
|
|
if(itime .eq. 0) then
|
|
nx=0
|
|
ny=0
|
|
itime=1
|
|
endif
|
|
|
|
CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to use'//&
|
|
CHAR(13)//'existing nodes?' ,&
|
|
'ELEMENT CREATION OPTION')
|
|
!
|
|
! If answer 'No', point to location
|
|
!
|
|
IF (WInfoDialog(4) .EQ. 2) then
|
|
noptcr=0
|
|
GO TO 4
|
|
else
|
|
noptcr=1
|
|
go to 1100
|
|
END IF
|
|
|
|
4 CONTINUE
|
|
NHTP=0
|
|
NMESS=8
|
|
NBRR = 3
|
|
CALL HEDR
|
|
!
|
|
! Get screen coordinates of each end of line
|
|
!
|
|
7 CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
|
|
ALX=XTEMP
|
|
ALY=YTEMP
|
|
IF(IRMAIN .EQ. 1) RETURN
|
|
!
|
|
IF(IFLAG .EQ. 'q' .OR. (IFLAG .EQ. 'c' .AND. IBOX .EQ. 10))THEN
|
|
CALL WRTOUT(0)
|
|
RETURN
|
|
elseif(iflag .eq. 'n') then
|
|
call getfpna(XTEMP)
|
|
call getfpna(YTEMP)
|
|
ENDIF
|
|
!
|
|
! Exit input
|
|
!
|
|
9 CONTINUE
|
|
! CALL PLOTT(XTEMP,YTEMP,3)
|
|
! CALL PLOTT(XTEMP,YTEMP,2)
|
|
siz=0.1
|
|
call drawcr(xtemp,ytemp,siz)
|
|
NBRR=0
|
|
CALL HEDR
|
|
CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
|
|
ARX=XTEMP
|
|
ARY=YTEMP
|
|
if(iflag .eq. 'n') then
|
|
call getfpna(XTEMP)
|
|
call getfpna(YTEMP)
|
|
endif
|
|
IF(IRMAIN .EQ. 1) RETURN
|
|
!
|
|
12 CONTINUE
|
|
! CALL PLOTT(XTEMP,YTEMP,3)
|
|
! CALL PLOTT(XTEMP,YTEMP,2)
|
|
call drawcr(xtemp,ytemp,siz)
|
|
CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
|
|
BRX=XTEMP
|
|
BRY=YTEMP
|
|
if(iflag .eq. 'n') then
|
|
call getfpna(XTEMP)
|
|
call getfpna(YTEMP)
|
|
endif
|
|
IF(IRMAIN .EQ. 1) RETURN
|
|
!
|
|
16 CONTINUE
|
|
! CALL PLOTT(XTEMP,YTEMP,3)
|
|
! CALL PLOTT(XTEMP,YTEMP,2)
|
|
call drawcr(xtemp,ytemp,siz)
|
|
CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
|
|
BLX=XTEMP
|
|
BLY=YTEMP
|
|
if(iflag .eq. 'n') then
|
|
call getfpna(XTEMP)
|
|
call getfpna(YTEMP)
|
|
endif
|
|
IF(IRMAIN .EQ. 1) RETURN
|
|
!
|
|
20 CONTINUE
|
|
! CALL PLOTT(XTEMP,YTEMP,3)
|
|
! CALL PLOTT(XTEMP,YTEMP,2)
|
|
call drawcr(xtemp,ytemp,siz)
|
|
go to 25
|
|
|
|
1100 continue
|
|
CALL PROX(CORD(1,1),CORD(1,2),NP,xx,yy,INODE1,IFLAG,INSKP,IBOX)
|
|
ALX=CORD(INODE1,1)
|
|
ALY=CORD(INODE1,2)
|
|
CALL PROX(CORD(1,1),CORD(1,2),NP,xx,yy,INODE2,IFLAG,INSKP,IBOX)
|
|
ARX=CORD(INODE2,1)
|
|
ARY=CORD(INODE2,2)
|
|
CALL PROX(CORD(1,1),CORD(1,2),NP,xx,yy,INODE3,IFLAG,INSKP,IBOX)
|
|
BRX=CORD(INODE3,1)
|
|
BRY=CORD(INODE3,2)
|
|
CALL PROX(CORD(1,1),CORD(1,2),NP,xx,yy,INODE4,IFLAG,INSKP,IBOX)
|
|
BLX=CORD(INODE4,1)
|
|
BLY=CORD(INODE4,2)
|
|
|
|
!
|
|
! Define number of elements along x and y sides
|
|
!
|
|
25 CONTINUE
|
|
NMESS=45
|
|
CALL HEDR
|
|
NMESS = 9
|
|
call getint(nx)
|
|
! READ(*,*) NX
|
|
NMESS=45
|
|
CALL HEDR
|
|
NMESS = 10
|
|
call getint(ny)
|
|
! READ(*,*) NY
|
|
NXP=NX+1
|
|
NYP=NY+1
|
|
NRL=NX*NYP+1
|
|
NRT=NXP*NYP
|
|
|
|
! ipk jul01 test for limit exceeded
|
|
if(nrt .gt. maxpgen) then
|
|
call panelegn
|
|
go to 25
|
|
endif
|
|
|
|
DO N=1,NE
|
|
DO M=1,8
|
|
NOPSV(N,M)=NOP(N,M)
|
|
ENDDO
|
|
IMATSV(N)=IMAT(N)
|
|
ENDDO
|
|
NESAV=NE
|
|
NEFSAV=NENTRY
|
|
NPUNDO=NRT
|
|
!
|
|
! Initialize GRIDX and GRIDY
|
|
!
|
|
DO 100 N=1,NRT
|
|
GRIDX(N)=0.
|
|
GRIDY(N)=0.
|
|
IGSKP(N)=0
|
|
100 END DO
|
|
!
|
|
! Interpolate left and right side
|
|
!
|
|
CALL INTERP(GRIDX,GRIDY,1,NYP,1,ALX,ALY,BLX,BLY,NY,0)
|
|
CALL INTERP(GRIDX,GRIDY,NRL,NRT,1,ARX,ARY,BRX,BRY,NY,0)
|
|
!
|
|
! plot points
|
|
!
|
|
DO 200 N=1,NYP
|
|
!IPK MAY02
|
|
XTEMP=GRIDX(N)
|
|
YTEMP=GRIDY(N)
|
|
GRIDXL(N) = GRIDX(N)*TXSCAL - XS
|
|
GRIDYL(N) = GRIDY(N)*TXSCAL - YS
|
|
CALL PLOTT(XTEMP,YTEMP,3)
|
|
CALL PLOTT(XTEMP,YTEMP,2)
|
|
FPN = N
|
|
CALL RRed
|
|
! CALL NUMBR(XTEMP,YTEMP,0.20,FPN,0.0,-1)
|
|
siz=0.1
|
|
call drawcr(xtemp,ytemp,siz)
|
|
CALL RBlue
|
|
200 END DO
|
|
DO 220 N=NRL,NRT
|
|
!IPK MAY02
|
|
XTEMP=GRIDX(N)
|
|
YTEMP=GRIDY(N)
|
|
GRIDXL(N) = GRIDX(N)*TXSCAL - XS
|
|
GRIDYL(N) = GRIDY(N)*TXSCAL - YS
|
|
CALL PLOTT(XTEMP,YTEMP,3)
|
|
CALL PLOTT(XTEMP,YTEMP,2)
|
|
FPN = N
|
|
CALL RRed
|
|
! CALL NUMBR(XTEMP,YTEMP,0.20,FPN,0.0,-1)
|
|
call drawcr(xtemp,ytemp,siz)
|
|
CALL RBlue
|
|
220 END DO
|
|
!
|
|
! Interpolate bottom and top sides
|
|
!
|
|
CALL INTERP(GRIDX,GRIDY,1,NRL,NYP,ALX,ALY,ARX,ARY,NX,0)
|
|
CALL INTERP(GRIDX,GRIDY,NYP,NRT,NYP,BLX,BLY,BRX,BRY,NX,0)
|
|
!
|
|
! plot points
|
|
!
|
|
DO 240 N=1,NRL,NYP
|
|
!IPK MAY02
|
|
XTEMP=GRIDX(N)
|
|
YTEMP=GRIDY(N)
|
|
GRIDXL(N) = GRIDX(N)*TXSCAL - XS
|
|
GRIDYL(N) = GRIDY(N)*TXSCAL - YS
|
|
CALL PLOTT(XTEMP,YTEMP,3)
|
|
CALL PLOTT(XTEMP,YTEMP,2)
|
|
FPN = N
|
|
CALL RRed
|
|
! CALL NUMBR(XTEMP,YTEMP,0.20,FPN,0.0,-1)
|
|
call drawcr(xtemp,ytemp,siz)
|
|
CALL RBlue
|
|
240 END DO
|
|
DO 260 N=NYP,NRT,NYP
|
|
!IPK MAY02
|
|
XTEMP=GRIDX(N)
|
|
YTEMP=GRIDY(N)
|
|
GRIDXL(N) = GRIDX(N)*TXSCAL - XS
|
|
GRIDYL(N) = GRIDY(N)*TXSCAL - YS
|
|
CALL PLOTT(XTEMP,YTEMP,3)
|
|
CALL PLOTT(XTEMP,YTEMP,2)
|
|
FPN = N
|
|
CALL RRed
|
|
! CALL NUMBR(XTEMP,YTEMP,0.20,FPN,0.0,-1)
|
|
call drawcr(xtemp,ytemp,siz)
|
|
CALL RBlue
|
|
260 END DO
|
|
!
|
|
! Interpolate interior points
|
|
!
|
|
DO 300 M=2,NYP
|
|
NFS=NRL+M-1
|
|
CALL INTERP(GRIDX,GRIDY,M,NFS,NYP,GRIDX(M),GRIDY(M),GRIDX(NFS) &
|
|
& ,GRIDY(NFS),NX,0)
|
|
DO N=M,NFS
|
|
XTEMP=GRIDX(N)
|
|
YTEMP=GRIDY(N)
|
|
GRIDXL(N) = GRIDX(N)*TXSCAL - XS
|
|
GRIDYL(N) = GRIDY(N)*TXSCAL - YS
|
|
CALL RRed
|
|
call drawcr(xtemp,ytemp,siz)
|
|
CALL RBlue
|
|
ENDDO
|
|
300 END DO
|
|
305 CONTINUE
|
|
NMESS=11
|
|
NBRR=10
|
|
CALL HEDR
|
|
310 IBOX=1
|
|
ip=0
|
|
CALL PROX(GRIDX(1),GRIDY(1),NRT,XX,YY,IP,IFLAG,IGSKP,IBOX)
|
|
IF(IBOX .NE. 6 .and. (ip .gt. 0 .and. ip .le. nrt)) THEN
|
|
XKP=GRIDX(IP)
|
|
YKP=GRIDY(IP)
|
|
IPK=IP
|
|
ENDIF
|
|
IF(IRMAIN .EQ. 1 .OR. IBOX .EQ. 7) RETURN
|
|
IF(IFLAG .EQ. 'q') THEN
|
|
GO TO 400
|
|
ENDIF
|
|
DO N=1,NRT
|
|
GRIDX(N)=(GRIDXL(N)+XS)/TXSCAL
|
|
GRIDY(N)=(GRIDYL(N)+YS)/TXSCAL
|
|
ENDDO
|
|
IF(IBOX .EQ. 6) THEN
|
|
XX=XKP
|
|
YY=YKP
|
|
IP=IPK
|
|
GO TO 315
|
|
ENDIF
|
|
write(90,*) 'back prox irdisp',IRDISP
|
|
IF(IRDISP .EQ. 1) THEN
|
|
CALL PLTPT
|
|
ENDIF
|
|
!
|
|
! Get screen coordinate of new node location
|
|
!
|
|
CALL XYLOC(XX,YY,IFLAG,IBOX)
|
|
write(90,*) 'back xyloc irdisp',IRDISP
|
|
IF(IRMAIN .EQ. 1 .OR. IBOX .EQ. 7) RETURN
|
|
315 IF(IRDISP .EQ. 1) THEN
|
|
DO N=1,NRT
|
|
GRIDX(N)=(GRIDXL(N)+XS)/TXSCAL
|
|
GRIDY(N)=(GRIDYL(N)+YS)/TXSCAL
|
|
ENDDO
|
|
CALL PLTPT
|
|
ENDIF
|
|
!
|
|
! Establish difference from movement
|
|
!
|
|
ALX=XX-GRIDX(IP)
|
|
ALY=YY-GRIDY(IP)
|
|
CALL PLOTT(XX,YY,3)
|
|
CALL PLOTT(XX,YY,2)
|
|
FPN = IP
|
|
! CALL RRed
|
|
! CALL NUMBR(XX,YY,0.20,FPN,0.0,-1)
|
|
! CALL RBlue
|
|
!
|
|
! Find location on boundary
|
|
!
|
|
IF(IP .LE. NYP) THEN
|
|
! Left boundary
|
|
NLW=IP
|
|
NUP=NRL+IP-1
|
|
NSTP=NYP
|
|
BLX=0.
|
|
BLY=0.
|
|
NS=NX
|
|
ELSEIF(IP .GE. NRL) THEN
|
|
! Right boundary
|
|
NLW=IP-NX*NYP
|
|
NUP=IP
|
|
NSTP=NYP
|
|
BLX=ALX
|
|
BLY=ALY
|
|
ALX=0.
|
|
ALY=0.
|
|
NS=NX
|
|
ELSE
|
|
LINENO=(IP-1)/NYP
|
|
IF(IP-LINENO*NYP .EQ. 1) THEN
|
|
! Lower boundary
|
|
NLW=IP
|
|
NUP=IP+NY
|
|
NSTP=1
|
|
BLX=0.
|
|
BLY=0.
|
|
NS=NY
|
|
ELSEIF(IP-LINENO*NYP .EQ. NYP) THEN
|
|
! Upper boundary
|
|
NLW=IP-NY
|
|
NUP=IP
|
|
NSTP=1
|
|
BLX=ALX
|
|
BLY=ALY
|
|
ALX=0.
|
|
ALY=0.
|
|
NS=NY
|
|
ELSE
|
|
GO TO 305
|
|
ENDIF
|
|
ENDIF
|
|
!
|
|
! Interpolate change along x line
|
|
! 14935011
|
|
IF(IRGB .EQ. 14935011) THEN
|
|
call rgrey
|
|
ELSE
|
|
CALL RWHITEB
|
|
ENDIF
|
|
do n=1,nrt
|
|
XTEMP=gridx(n)
|
|
YTEMP=gridy(n)
|
|
call drawcr(xtemp,ytemp,siz)
|
|
enddo
|
|
CALL RRed
|
|
CALL INTERP(GRIDX,GRIDY,NLW,NUP,NSTP,ALX,ALY,BLX,BLY,NS,1)
|
|
do n=1,nrt
|
|
XTEMP=gridx(n)
|
|
YTEMP=gridy(n)
|
|
call drawcr(xtemp,ytemp,siz)
|
|
GRIDXL(N) = GRIDX(N)*TXSCAL - XS
|
|
GRIDYL(N) = GRIDY(N)*TXSCAL - YS
|
|
enddo
|
|
call Rblue
|
|
GO TO 310
|
|
!
|
|
! Copy points into cord array
|
|
!
|
|
400 CONTINUE
|
|
DO 500 N=1,NRT
|
|
!
|
|
! Find next blank node in CORD
|
|
!
|
|
IF(NOPTCR .EQ. 1) THEN
|
|
IF(N .EQ. 1) THEN
|
|
NODDEL(N)=0
|
|
GO TO 500
|
|
ELSEIF(N .EQ. NYP) THEN
|
|
NODDEL(N)=0
|
|
GO TO 500
|
|
ELSEIF(N .EQ. 1+NYP*NX) THEN
|
|
NODDEL(N)=0
|
|
GO TO 500
|
|
ELSEIF(N .EQ. NRT) THEN
|
|
NODDEL(N)=0
|
|
GO TO 500
|
|
ENDIF
|
|
ENDIF
|
|
CALL GETNOD(J)
|
|
NODDEL(N)=J
|
|
!
|
|
! Store GRIDX and GRIDY into it
|
|
!
|
|
CORD(J,1) = GRIDX(N)
|
|
CORD(J,2) = GRIDY(N)
|
|
IGRIDE(N) = J
|
|
INEW(J) = 1
|
|
INSKP(J) = 0
|
|
!
|
|
XUSR(J) = GRIDX(N)*TXSCAL - XS
|
|
YUSR(J) = GRIDY(N)*TXSCAL - YS
|
|
!
|
|
! Display point
|
|
!
|
|
CALL PLTNOD(J,1)
|
|
!
|
|
500 END DO
|
|
!
|
|
! Generate elements
|
|
!
|
|
CALL GETELM(K)
|
|
IECHG=0
|
|
!
|
|
DO 600 I=1,NX
|
|
DO 590 J=1,NY
|
|
CALL GETELM(K)
|
|
IF(I .EQ. 1 .AND. J .EQ. 1 .AND. NOPTCR .EQ. 1) THEN
|
|
NOP(K,1)=INODE1
|
|
ELSE
|
|
NOP(K,1)=IGRIDE((I-1)*NYP+J)
|
|
ENDIF
|
|
NOP(K,2)=0
|
|
IF(I .EQ. NX .AND. J .EQ. 1 .AND. NOPTCR .EQ. 1) THEN
|
|
NOP(K,3)=INODE2
|
|
ELSE
|
|
NOP(K,3)=IGRIDE(I*NYP+J)
|
|
ENDIF
|
|
NOP(K,4)=0
|
|
IF(I .EQ. NX .AND. J .EQ. NY .AND. NOPTCR .EQ. 1) THEN
|
|
NOP(K,5)=INODE3
|
|
ELSE
|
|
NOP(K,5)=IGRIDE(I*NYP+J+1)
|
|
ENDIF
|
|
NOP(K,6)=0
|
|
IF(I .EQ. 1 .AND. J .EQ. NY .AND. NOPTCR .EQ. 1) THEN
|
|
NOP(K,7)=INODE4
|
|
ELSE
|
|
NOP(K,7)=IGRIDE((I-1)*NYP+J+1)
|
|
ENDIF
|
|
NOP(K,8)=0
|
|
IMAT(K)=1
|
|
! IF(K .GT. NE) NE=K
|
|
NCORN(K)=8
|
|
IESKP(K)=0
|
|
!IPK JAN98
|
|
IERC=0
|
|
CALL PLTELM(K,IERC)
|
|
590 CONTINUE
|
|
600 END DO
|
|
! CALL UNDO(IYES)
|
|
! IF(IYES .EQ. 1) THEN
|
|
! DO N=1,NEUNDO
|
|
! J=IELDEL(N)
|
|
! CALL DELTEL(J)
|
|
! ENDDO
|
|
! DO N=1,NPUNDO
|
|
! J=NODDEL(N)
|
|
! CALL DELETN(J)
|
|
! ENDDO
|
|
! ENDIF
|
|
CALL WRTOUT(0)
|
|
RETURN
|
|
END
|
|
|
|
SUBROUTINE PLTPT
|
|
|
|
USE BLK1MOD
|
|
INCLUDE 'TXFRM.COM'
|
|
! INCLUDE 'BLK1.COM'
|
|
|
|
!IPK MAY02
|
|
REAL*8 GRIDX,GRIDY,GRIDXL,GRIDYL
|
|
INTEGER*2 IGSKP
|
|
|
|
COMMON /GBLK/ GRIDX(MAXPGEN),GRIDY(MAXPGEN),GRIDXL(MAXPGEN),GRIDYL(MAXPGEN)&
|
|
,IGSKP(MAXPGEN),NRL,NRT,NYP,IGRIDE(MAXPGEN)
|
|
|
|
DO N=1,NRT
|
|
GRIDX(N)=(GRIDXL(N)+XS)/TXSCAL
|
|
GRIDY(N)=(GRIDYL(N)+YS)/TXSCAL
|
|
ENDDO
|
|
|
|
!
|
|
! plot points
|
|
!
|
|
DO N=1,NYP
|
|
!IPK MAY02
|
|
XTEMP=GRIDX(N)
|
|
YTEMP=GRIDY(N)
|
|
CALL PLOTT(XTEMP,YTEMP,3)
|
|
CALL PLOTT(XTEMP,YTEMP,2)
|
|
FPN = N
|
|
CALL RRed
|
|
! CALL NUMBR(XTEMP,YTEMP,0.20,FPN,0.0,-1)
|
|
siz=0.1
|
|
call drawcr(xtemp,ytemp,siz)
|
|
CALL RBlue
|
|
END DO
|
|
DO N=NRL,NRT
|
|
!IP MAY02
|
|
XTEMP=GRIDX(N)
|
|
YTEMP=GRIDY(N)
|
|
CALL PLOTT(XTEMP,YTEMP,3)
|
|
CALL PLOTT(XTEMP,YTEMP,2)
|
|
FPN = N
|
|
CALL RRed
|
|
! CALL NUMBR(XTEMP,YTEMP,0.20,FPN,0.0,-1)
|
|
call drawcr(xtemp,ytemp,siz)
|
|
CALL RBlue
|
|
END DO
|
|
!
|
|
! plot points
|
|
!
|
|
DO N=1,NRL,NYP
|
|
!IPK MAY02
|
|
XTEMP=GRIDX(N)
|
|
YTEMP=GRIDY(N)
|
|
CALL PLOTT(XTEMP,YTEMP,3)
|
|
CALL PLOTT(XTEMP,YTEMP,2)
|
|
FPN = N
|
|
CALL RRed
|
|
! CALL NUMBR(XTEMP,YTEMP,0.20,FPN,0.0,-1)
|
|
call drawcr(xtemp,ytemp,siz)
|
|
CALL RBlue
|
|
END DO
|
|
DO N=NYP,NRT,NYP
|
|
!IPK MAY02
|
|
XTEMP=GRIDX(N)
|
|
YTEMP=GRIDY(N)
|
|
CALL PLOTT(XTEMP,YTEMP,3)
|
|
CALL PLOTT(XTEMP,YTEMP,2)
|
|
FPN = N
|
|
CALL RRed
|
|
! CALL NUMBR(XTEMP,YTEMP,0.20,FPN,0.0,-1)
|
|
call drawcr(xtemp,ytemp,siz)
|
|
CALL RBlue
|
|
END DO
|
|
RETURN
|
|
END
|
|
|
|
subroutine panelegn
|
|
|
|
USE WINTERACTER
|
|
|
|
CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'You have requested '//&
|
|
' more than the allowable number of nodes.'//CHAR(13)//'The model will return '// &
|
|
'to allow new numbers to be input','Limit error')
|
|
!
|
|
! If answer 'Yes', execute
|
|
!
|
|
IF (WInfoDialog(4) .EQ. 1) then
|
|
return
|
|
ENDIF
|
|
return
|
|
end
|
|
SUBROUTINE FORMLINEMENU(ITYP,I1D,I2D,IFIN,XLENGTH,ITYPIN,NELC)
|
|
|
|
|
|
use winteracter
|
|
|
|
implicit none
|
|
SAVE
|
|
|
|
include 'D.inc'
|
|
INCLUDE 'BFILES.I90'
|
|
DATA ITIME/0/
|
|
|
|
!
|
|
! Declare window-type and message variables
|
|
!
|
|
TYPE(WIN_STYLE) :: WINDOW
|
|
|
|
TYPE(WIN_MESSAGE) :: MESSAGE
|
|
|
|
integer :: ITYP,I1D,IERR,ITIME,I2D,IFIN,ITYPIN,NELC
|
|
real :: XLENGTH
|
|
character*3 :: sub
|
|
DATA ITIME/0/
|
|
IF(ITIME .EQ. 0) THEN
|
|
XLENGTH=100.
|
|
ITIME=1
|
|
I1D=0
|
|
I2D=1
|
|
IFIN=1
|
|
ITYPIN=1
|
|
NELC=2
|
|
ENDIF
|
|
|
|
|
|
|
|
call wdialogload(IDD_FORMLINE)
|
|
ierr=infoerror(1)
|
|
|
|
call wdialogputRadioButton(idf_radio1)
|
|
call wdialogputRadioButton(idf_radio3)
|
|
CALL WDialogPutREAL(idf_REAL1,XLENGTH)
|
|
CALL WDialogPutInteger(idf_INTEGER1,ITYPIN)
|
|
call wdialogPutCheckBox(idf_check3,IFIN)
|
|
CALL WDialogPutInteger(idf_INTEGER2,NELC)
|
|
|
|
|
|
CALL WDialogSelect(IDD_FORMLINE)
|
|
ierr=infoerror(1)
|
|
|
|
CALL WDialogShow(-1,-1,0,Modal)
|
|
ierr=infoerror(1)
|
|
DO
|
|
IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
|
|
call wdialogGetRadioButton(idf_radio1,ITYP)
|
|
call wdialogGetRadioButton(idf_radio3,I1D)
|
|
call wdialogGetCheckBox(idf_check3,IFIN)
|
|
CALL WDialogGetREAL(idf_REAL1,XLENGTH)
|
|
CALL WDialogGetInteger(idf_INTEGER1,ITYPIN)
|
|
CALL WDialogGetInteger(idf_INTEGER2,NELC)
|
|
if(I1D .eq. 1) then
|
|
I1D=0
|
|
I2D=0
|
|
ELSEIF(I1D .EQ. 2) THEN
|
|
I1D=1
|
|
I2D=0
|
|
ELSEIF(I1D .EQ. 3) THEN
|
|
I1D=0
|
|
I2D=1
|
|
ENDIF
|
|
RETURN
|
|
ELSEIF(WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
|
|
I1D=-999
|
|
RETURN
|
|
ENDIF
|
|
ENDDO
|
|
RETURN
|
|
END
|
|
|
|
SUBROUTINE FILEDAT(ALXX,ALYY,ALWD,NPTS,BLXX,BLYY,BLWD,NPTSB,ITYPBC)
|
|
USE WINTERACTER
|
|
USE DFLIB
|
|
!
|
|
!
|
|
! Define some parameters to match those in the resource file
|
|
!
|
|
include 'd.inc'
|
|
REAL*8 ALXX(*),ALYY(*),ALWD(*),BLXX(*),BLYY(*),BLWD(*)
|
|
INTEGER ITYPBC(*)
|
|
REAL*8 ATMPAR
|
|
CHARACTER(LEN=255) :: FNAME,FILTER
|
|
CHARACTER(LEN=3) :: SUB
|
|
CHARACTER ID*8,DLIN*72
|
|
IINALN=45
|
|
Filter='ALIGNMENT file -- *.dat|'
|
|
|
|
CALL WSelectFile(Filter,PromptOn,FNAME,'Open Alignment File')
|
|
|
|
IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
|
|
|
|
CALL IlowerCase(FNAME)
|
|
CALL GETSUB(FNAME,SUB)
|
|
OPEN(IINALN,FILE=FNAME,STATUS='OLD',action='read')
|
|
ELSE
|
|
RETURN
|
|
ENDIF
|
|
DO K=1,1000
|
|
CALL GINPT(IINALN,ID,DLIN)
|
|
IF(ID(1:3) .EQ. 'XYW') THEN
|
|
READ(DLIN,*) ALXX(K),ALYY(K),ALWD(K)
|
|
ELSEIF(ID(1:3) .EQ. 'XY ') THEN
|
|
READ(DLIN,*) ALXX(K),ALYY(K)
|
|
ALWD(K)=0.
|
|
ELSE
|
|
NPTS=K-1
|
|
BACKSPACE(IINALN)
|
|
GOTO 200
|
|
ENDIF
|
|
ENDDO
|
|
200 CONTINUE
|
|
READ(IINALN,'(A8)') ID
|
|
IF(ID(1:7) .EQ. 'ENDFILE') RETURN
|
|
|
|
CALL GETBRIDCUL(IINALN,ALXX,ALYY,BLXX,BLYY,BLWD,NPTSB,ITYPBC)
|
|
K=(NPTSB-2)/2+2
|
|
ALXX(K)=ALXX(2)
|
|
ALYY(K)=ALYY(2)
|
|
NPTS=K
|
|
DO K=2,NPTSB-2,2
|
|
ALXX(K+1)=(BLXX(K)+BLXX(K+1))/2.
|
|
ALYY(K+1)=(BLYY(K)+BLYY(K+1))/2.
|
|
ALWD(K+1)=(BLWD(K)+BLWD(K+1))/2.
|
|
ENDDO
|
|
|
|
! DO K=1,1000
|
|
! ATMPAR=BLXX(K)
|
|
! BLXX(K)=ALXX(K)
|
|
! ALXX(K)=ATMPAR
|
|
! ATMPAR=BLYY(K)
|
|
! BLYY(K)=ALYY(K)
|
|
! ALYY(K)=ATMPAR
|
|
! ENDDO
|
|
! NTEMP=NPTSB
|
|
! NPTSB=NPTS
|
|
! NPTS=NTEMP
|
|
RETURN
|
|
END
|
|
SUBROUTINE GETBRIDCUL(IINALN,ALXX,ALYY,BLXX,BLYY,BLWD,NPTSB,ITYPBC)
|
|
CHARACTER(LEN=140) :: DLINLARGE
|
|
CHARACTER(LEN=8) :: ID
|
|
REAL*8 TEMP(8)
|
|
REAL*8 ALXX(*),ALYY(*),BLXX(*),BLYY(*),BLWD(*)
|
|
INTEGER ITYPBC(*)
|
|
PI=3.14159
|
|
KK=1
|
|
DO K=1,1000
|
|
CALL GINPT1(IINALN,DLINLARGE)
|
|
IF(DLINLARGE(1:7) .EQ. 'CULVERT') THEN
|
|
READ(DLINLARGE(8:140),*) IDN,(TEMP(J),J=1,8)
|
|
ITYPBC(KK)=1
|
|
ITYPBC(KK+1)=1
|
|
XCEN=(TEMP(2)+TEMP(4))/2.
|
|
YCEN=(TEMP(3)+TEMP(5))/2.
|
|
CW=TEMP(7)*TEMP(8)/2.
|
|
IF(KK .EQ. 1) THEN
|
|
DNORM=ATAN2(TEMP(3)-ALYY(1),TEMP(2)-ALXX(1))
|
|
ELSE
|
|
DNORM=ATAN2(TEMP(3)-BLYY(KK-1),TEMP(2)-BLXX(KK-1))
|
|
ENDIF
|
|
WRITE(155,*) KK,DNORM
|
|
IF(DNORM .LT. 0.) DNORM=DNORM+PI
|
|
IF(DNORM .GT. PI) DNORM=DNORM-PI
|
|
WRITE(155,*) KK,DNORM
|
|
BLXX(KK)=XCEN-CW*COS(DNORM)
|
|
BLYY(KK)=YCEN-CW*SIN(DNORM)
|
|
BLWD(KK)=TEMP(6)
|
|
KK=KK+1
|
|
BLXX(KK)=XCEN+CW*COS(DNORM)
|
|
BLYY(KK)=YCEN+CW*SIN(DNORM)
|
|
BLWD(KK)=TEMP(6)
|
|
KK=KK+1
|
|
ELSEIF(DLINLARGE(1:6) .EQ. 'BRIDGE') THEN
|
|
READ(DLINLARGE(7:140),*) IDN,(TEMP(J),J=1,7)
|
|
ITYPBC(KK)=2
|
|
ITYPBC(KK+1)=2
|
|
BLXX(KK)=TEMP(2)
|
|
BLYY(KK)=TEMP(3)
|
|
BLWD(KK)=TEMP(4)
|
|
KK=KK+1
|
|
BLXX(KK)=TEMP(5)
|
|
BLYY(KK)=TEMP(6)
|
|
BLWD(KK)=TEMP(7)
|
|
KK=KK+1
|
|
READ(DLINLARGE(8:140),*) ID,(TEMP(J),J=1,6)
|
|
ELSEIF(DLINLARGE(1:7) .EQ. 'ENDFILE') THEN
|
|
NPTSB=KK-1
|
|
GO TO 200
|
|
ENDIF
|
|
ENDDO
|
|
200 CONTINUE
|
|
DO K=1,NPTSB
|
|
WRITE(156,*) K,BLXX(K),BLYY(K),BLWD(K)
|
|
ENDDO
|
|
RETURN
|
|
END
|
|
|
|
|
|
|