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.
1737 lines
63 KiB
Fortran
1737 lines
63 KiB
Fortran
5 years ago
|
!ipk last update March 6 2000 fix IMAT display bug
|
||
|
|
!ipk last update Feb 22 1999 add element type option
|
||
|
|
!ipk last update Jan 21 1999 add plotting of storage widths
|
||
|
|
!ipk lsat update oct 23 1998 change location of label in pgrid
|
||
|
|
!
|
||
|
|
!****************************************************************
|
||
|
|
!
|
||
|
|
!ipk nov97 change call
|
||
|
|
SUBROUTINE PLOTOT(imz)
|
||
|
|
!
|
||
|
|
! Display grid according to switch setting
|
||
|
|
!
|
||
|
|
USE WINTERACTER
|
||
|
|
USE BLKMAP
|
||
|
|
USE BLK1MOD
|
||
|
|
USE BLK2MOD
|
||
|
|
! INCLUDE 'BLK1.COM'
|
||
|
|
INCLUDE 'BFILES.I90'
|
||
|
|
include 'TXFRM.COM'
|
||
|
|
DIMENSION XLIN(350),YLIN(350)
|
||
|
|
CHARACTER*1 IFLAG
|
||
|
|
CHARACTER*80 LIND
|
||
|
|
!ycw mar97 add for cross section
|
||
|
|
REAL XPL(5),YPL(5)
|
||
|
|
INTEGER :: iw,ih,ihandle,ient,IHAND1,IHAND2,IXPM,IYPX,IXPX,IYPM
|
||
|
|
common /hands/ iw,ih,ihandle,IHAND1,IHAND2,IXPM,IYPX,IXPX,IYPM
|
||
|
|
DATA IFIRST/0/
|
||
|
|
IF(IFIRST .EQ. 0) THEN
|
||
|
|
NTTRAC=0
|
||
|
|
IFIRST=1
|
||
|
|
ENDIF
|
||
|
|
HT=0.2
|
||
|
|
! CALL CHEXIT
|
||
|
|
!
|
||
|
|
if(imz .ne. 2) CALL CLSCRN
|
||
|
|
!
|
||
|
|
!ipk oct97 output to backup file
|
||
|
|
!
|
||
|
|
!ipk test for write to backup
|
||
|
|
if(imz .eq. 1) then
|
||
|
|
rewind ibak
|
||
|
|
call wrtout(0)
|
||
|
|
endif
|
||
|
|
!
|
||
|
|
!ycw mar97 add for cross section
|
||
|
|
if(LCROSS) then
|
||
|
|
!! call plotcs
|
||
|
|
return
|
||
|
|
endif
|
||
|
|
!ycw
|
||
|
|
!
|
||
|
|
! Rescale coordinates for plotting
|
||
|
|
!
|
||
|
|
CALL SCLMAP
|
||
|
|
!rrr
|
||
|
|
IF (IPSW(8) .EQ. 1) CALL PGRID
|
||
|
|
!
|
||
|
|
CALL SCLCRD
|
||
|
|
!ycw mar97 add for cross section
|
||
|
|
if(ICRS.ne.0) then
|
||
|
|
do i=1,2
|
||
|
|
XPCS(i)=(XPCS(i)-XMIN)/PSCALE
|
||
|
|
YPCS(i)=(YPCS(i)-YMIN)/PSCALE
|
||
|
|
enddo
|
||
|
|
do i=1,NCSNOD
|
||
|
|
XCND(i)=(XCND(i)-XMIN)/PSCALE
|
||
|
|
YCND(i)=(YCND(i)-YMIN)/PSCALE
|
||
|
|
enddo
|
||
|
|
endif
|
||
|
|
!ycw
|
||
|
|
PSCALE = 1.
|
||
|
|
XMIN = 0.
|
||
|
|
YMIN = 0.
|
||
|
|
! if(np .gt. 100000) call backc(1)
|
||
|
|
|
||
|
|
! if(ipsw(4) .eq. 1) then
|
||
|
|
! do j=1,ne
|
||
|
|
! if(ieskp(j) .eq. 0 .and. imz .ne. 2) call fillemC(j,1)
|
||
|
|
! enddo
|
||
|
|
! endif
|
||
|
|
! write(90,*) 'going to drawbk',nbkfl,iswbkfl(1)
|
||
|
|
! IF(NBKFL .GT. 0) THEN
|
||
|
|
! DO I=1,NBKFL
|
||
|
|
! IF(ISWBKFL(I) .EQ. 1) CALL DRAWBK(I,IMZ)
|
||
|
|
! IF(ISWBKFL(I) .EQ. 2) CALL DRAWBKBM(I,IMZ)
|
||
|
|
! ENDDO
|
||
|
|
! ENDIF
|
||
|
|
IF(IDDSW .EQ. -1) THEN
|
||
|
|
IF(NP .GT. 100000) THEN
|
||
|
|
IDDSW=0
|
||
|
|
ELSE
|
||
|
|
IDDSW=1
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
IF(IPSW(6) .EQ. 1 .AND. IGUNIT .EQ. 203) THEN
|
||
|
|
IDDSW=0
|
||
|
|
ELSEIF(NP .LE. 100000) THEN
|
||
|
|
IDDSW=1
|
||
|
|
ENDIF
|
||
|
|
if(IDDSW .EQ. 0) call backc(1)
|
||
|
|
|
||
|
|
if(ipsw(4) .eq. 1) then
|
||
|
|
jj=1
|
||
|
|
if(nbkfl .gt. 0) jj=16
|
||
|
|
do j=1,ne
|
||
|
|
|
||
|
|
if(ieskp(j) .eq. 0 .and. imz .ne. 2) call fillemC(j,jj)
|
||
|
|
enddo
|
||
|
|
endif
|
||
|
|
|
||
|
|
IF(NBKFL .GT. 0) THEN
|
||
|
|
DO I=1,NBKFL
|
||
|
|
IF(ISWBKFL(I) .EQ. 1) CALL DRAWBK(I,IMZ)
|
||
|
|
IF(ISWBKFL(I) .EQ. 2) CALL DRAWBKBM(I,IMZ)
|
||
|
|
ENDDO
|
||
|
|
ENDIF
|
||
|
|
! write(90,*) 'finished drawbk'
|
||
|
|
!
|
||
|
|
! Plot map data
|
||
|
|
!
|
||
|
|
IF(IMP .NE. 0) THEN
|
||
|
|
IF(IPSW(1) .EQ. 1) THEN
|
||
|
|
CALL PLTMAP
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
!
|
||
|
|
! If IPSW(1) = 1 plot map or plot outline if no map
|
||
|
|
!
|
||
|
|
IF(IMP .EQ. 0) THEN
|
||
|
|
IF(IPSW(1) .EQ. 1) IPSW(2)=1
|
||
|
|
!ipk sep94 allow plotting of outline after map
|
||
|
|
! ELSE
|
||
|
|
! IF(IPSW(1) .EQ. 1) GO TO 10
|
||
|
|
ENDIF
|
||
|
|
!
|
||
|
|
! Plot outline of grid only
|
||
|
|
!
|
||
|
|
IF(IPSW(2) .EQ. 1) THEN
|
||
|
|
CALL OUTLN
|
||
|
|
! GO TO 250
|
||
|
|
ENDIF
|
||
|
|
!
|
||
|
|
! Plot nodes when IPSW(3) .EQ. 1
|
||
|
|
!
|
||
|
|
10 CONTINUE
|
||
|
|
IF(IPSW(3) .EQ. 1 .OR. IPSW(9) .EQ. 1 .OR. IPSW(14) .EQ. 1) THEN
|
||
|
|
IF(NP .GT. 0) THEN
|
||
|
|
IF(IPSW(3) .EQ. 1) ITP=0
|
||
|
|
IF(IPSW(14) .EQ. 1) ITP=2
|
||
|
|
IF(IPSW(9) .EQ. 1) then
|
||
|
|
ITP=-1
|
||
|
|
wdmin=1.e10
|
||
|
|
wdmax=-1.e10
|
||
|
|
do j=1,np
|
||
|
|
IF(INSKP(J) .EQ. 1) cycle
|
||
|
|
IF(CORD(J,1) .GT. 0. .AND. CORD(J,1) .LT. HSIZE) THEN
|
||
|
|
IF(CORD(J,2) .GT. 0. .AND. CORD(J,2) .LT. 7.5) THEN
|
||
|
|
wdmin=min(wdmin,wd(j))
|
||
|
|
wdmax=max(wdmax,wd(j))
|
||
|
|
else
|
||
|
|
cycle
|
||
|
|
endif
|
||
|
|
else
|
||
|
|
cycle
|
||
|
|
endif
|
||
|
|
enddo
|
||
|
|
if(abs(wdmin) .gt. abs(wdmax)) then
|
||
|
|
temp=log10(abs(wdmin))
|
||
|
|
elseif(wdmin .eq. 0) then
|
||
|
|
temp=2.5
|
||
|
|
else
|
||
|
|
temp=log10(wdmax)
|
||
|
|
endif
|
||
|
|
if(temp .gt. 2.) then
|
||
|
|
itp=-3
|
||
|
|
elseif(temp .gt. 1.) then
|
||
|
|
itp=-4
|
||
|
|
else
|
||
|
|
itp=-5
|
||
|
|
endif
|
||
|
|
endif
|
||
|
|
DO 15 J=1,NP
|
||
|
|
! IF(MOD(J,10) .EQ. 0) THEN
|
||
|
|
! CALL CHINT(IFLAG)
|
||
|
|
! IF(IFLAG .EQ. 'i') GO TO 250
|
||
|
|
! ENDIF
|
||
|
|
IF(INSKP(J) .EQ. 1) GO TO 15
|
||
|
|
IF(CORD(J,1) .GT. 0. .AND. CORD(J,1) .LT. HSIZE) THEN
|
||
|
|
IF(CORD(J,2) .GT. 0. .AND. CORD(J,2) .LT. 7.5) THEN
|
||
|
|
CALL PLTNOD(J,ITP)
|
||
|
|
GO TO 15
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
INSKP(J)=1
|
||
|
|
15 CONTINUE
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
!
|
||
|
|
! Plot data points
|
||
|
|
!
|
||
|
|
IF(IPSW(6) .EQ. 1) THEN
|
||
|
|
IF(IGUNIT .EQ.203) THEN
|
||
|
|
LENROW=NCOLS1*4
|
||
|
|
FCT=10**NSIGF
|
||
|
|
raddisp=rad/txscal
|
||
|
|
if(raddisp .lt. 0.01) raddisp=0.01
|
||
|
|
if(colint .eq. 0.) colint=1.
|
||
|
|
CALL IGrFillPattern(4)
|
||
|
|
IF(ICOLSW .EQ. 0) THEN
|
||
|
|
INTH=TXSCAL*0.08*FLOAT(NSIGF+3)/CELLSIZX+1
|
||
|
|
DO J=1,NCOLS1
|
||
|
|
XCOL(J)=(CELLSIZX*(J-1)+XXORG+XS)/TXSCAL
|
||
|
|
ENDDO
|
||
|
|
INTV=TXSCAL*0.12/CELLSIZY+1
|
||
|
|
DO I=1,NROWS1,INTV
|
||
|
|
YCOL(I)=(CELLSIZY*(NROWS1+1-I)+YYORG+YS)/TXSCAL
|
||
|
|
IF(YCOL(I) .GT. 0. .AND. YCOL(I) .LT. 7.5) THEN
|
||
|
|
READ(203,POS=LENROW*(I-1)+1) (VALLIN(J),J=1,NCOLS1)
|
||
|
|
DO J=1,NCOLS1,INTH
|
||
|
|
IF(VALLIN(J) .GT. -9000.) THEN
|
||
|
|
IF(XCOL(J) .LT. 0. .AND. XCOL(J) .GT. HSIZE) CYCLE
|
||
|
|
CALL PLOTT(XCOL(J),YCOL(I),3)
|
||
|
|
CALL PLOTT(XCOL(J),YCOL(I),2)
|
||
|
|
|
||
|
|
CALL Rblack
|
||
|
|
if(nsigf .lt.1) then
|
||
|
|
nsigff=1
|
||
|
|
else
|
||
|
|
nsigff=nsigf
|
||
|
|
endif
|
||
|
|
CALL NUMBR(XCOL(J),YCOL(I),0.12,VALLIN(J),0.0,NSIGFF)
|
||
|
|
CALL RBlue
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
ELSE
|
||
|
|
DO J=1,NCOLS1
|
||
|
|
XCOL(J)=(CELLSIZX*(J-1)+XXORG+XS)/TXSCAL
|
||
|
|
ENDDO
|
||
|
|
INTV=TXSCAL*7.5/(FLOAT(IH)*CELLSIZY)+1
|
||
|
|
DO I=1,NROWS1,INTV
|
||
|
|
YCOL(I)=(CELLSIZY*(NROWS1+1-I)+YYORG+YS)/TXSCAL
|
||
|
|
IF(YCOL(I) .GT. 0. .AND. YCOL(I) .LT. 7.5) THEN
|
||
|
|
READ(203,POS=LENROW*(I-1)+1) (VALLIN(J),J=1,NCOLS1)
|
||
|
|
DO J=1,NCOLS1,INTV
|
||
|
|
IF(VALLIN(J) .GT. -9000.) THEN
|
||
|
|
IF(XCOL(J) .LT. 0. .AND. XCOL(J) .GT. HSIZE) CYCLE
|
||
|
|
IF(VALLIN(J) .GE. 0.) THEN
|
||
|
|
NCOLN=VALLIN(J)/COLINT+0.5
|
||
|
|
ELSE
|
||
|
|
NCOLN=-VALLIN(J)/COLINT-0.5
|
||
|
|
ENDIF
|
||
|
|
NCOLN=MOD(NCOLN,13)+2
|
||
|
|
CALL CHANGE_COLOR(NCOLN)
|
||
|
|
! CALL IGrCircle(XCOL(J),YCOL(I),RADDISP)
|
||
|
|
CALL IGrRectangle(XCOL(J)-RADDISP,YCOL(I)-RADDISP,XCOL(J)+RADDISP,YCOL(I)+RADDISP)
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
ENDIF
|
||
|
|
ELSE
|
||
|
|
DO 40 J=1,MAXPTS,nmapf
|
||
|
|
IF(MOD(J,100000) .EQ. 0) WRITE(155,*) J,' points processed'
|
||
|
|
IF(VAL(J) .GT. -9000.) THEN
|
||
|
|
X=CMAP(J,1)
|
||
|
|
Y=CMAP(J,2)
|
||
|
|
IF(X .GT. 0. .AND. X .LT. HSIZE) THEN
|
||
|
|
IF(Y .GT. 0. .AND. Y .LT. 7.5) THEN
|
||
|
|
CALL PLOTT(X,Y,3)
|
||
|
|
if(icolsw .eq. 0) then
|
||
|
|
CALL PLOTT(X,Y,2)
|
||
|
|
|
||
|
|
CALL Rblack
|
||
|
|
! ipk mar01
|
||
|
|
! ipk jun04 CALL NUMBR(X,Y,0.15,VAL(J)*FCT,0.0,-1)
|
||
|
|
if(nsigf .lt.1) then
|
||
|
|
nsigff=1
|
||
|
|
else
|
||
|
|
nsigff=nsigf
|
||
|
|
endif
|
||
|
|
call numbr(x,y,0.12,val(j),0.0,nsigff)
|
||
|
|
CALL RBlue
|
||
|
|
else
|
||
|
|
if(val(j) .ge. 0.) then
|
||
|
|
ncoln=val(j)/colint
|
||
|
|
else
|
||
|
|
ncoln=-val(j)/colint
|
||
|
|
endif
|
||
|
|
ncoln=mod(ncoln,13)+2
|
||
|
|
call change_color(ncoln)
|
||
|
|
CALL IGrCircle(X,Y,RADDISP)
|
||
|
|
! call circle(x,y,raddisp)
|
||
|
|
endif
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
40 CONTINUE
|
||
|
|
ENDIF
|
||
|
|
Call RBlue
|
||
|
|
! GO TO 250
|
||
|
|
ENDIF
|
||
|
|
!
|
||
|
|
! Plot existing elements
|
||
|
|
!
|
||
|
|
!ipk add element type option
|
||
|
|
IF(IPSW(5) .EQ. 1 .OR. IPSW(4) .EQ. 1 .or. ipsw(7) .eq. 1) THEN
|
||
|
|
! CALL PLOTT(0.,7.0,3)
|
||
|
|
! CALL PLOTT(10.,7.0,2)
|
||
|
|
!IPK JAN98
|
||
|
|
IERC=imz
|
||
|
|
if(ne .gt. 0) then
|
||
|
|
DO 20 J=1,NE
|
||
|
|
XC(J)=VOID
|
||
|
|
YC(J)=VOID
|
||
|
|
! IF(MOD(J,10) .EQ. 0) THEN
|
||
|
|
! CALL CHINT(IFLAG)
|
||
|
|
! IF(IFLAG .EQ. 'i') GO TO 250
|
||
|
|
! ENDIF
|
||
|
|
IF(IESKP(J) .EQ. 0) THEN
|
||
|
|
!IPK JAN98 ADD IERC
|
||
|
|
IF (IMAT(J) .NE. 0) CALL PLTELM(J,IERC)
|
||
|
|
ENDIF
|
||
|
|
20 CONTINUE
|
||
|
|
IF(IERC .GT. 0) THEN
|
||
|
|
! call clscrn()
|
||
|
|
! WRITE(LIND,*) ' Zero node corner nodes'
|
||
|
|
! call symbl &
|
||
|
|
! & (1.1,5.5,0.25,LIND,0.0,80)
|
||
|
|
! WRITE(LIND,*) ' See MESSAGES.OUT file for details'
|
||
|
|
! call symbl &
|
||
|
|
! & (1.1,5.2,0.25,LIND,0.0,80)
|
||
|
|
! WRITE(LIND,*) ' Press enter to terminate'
|
||
|
|
! call symbl &
|
||
|
|
! & (1.1,4.9,0.25,LIND,0.0,80)
|
||
|
|
! ndig=1
|
||
|
|
! CALL GTCHARX(IFLAG,NDIG,5.0,5.5)
|
||
|
|
! CALL QUIT_PGM()
|
||
|
|
! stop
|
||
|
|
CALL WMessageBox(0,0,0,'Error in element connnection'//&
|
||
|
|
CHAR(13)//'Zero corner node found'//&
|
||
|
|
CHAR(13)//'See Mesgen.out for details',&
|
||
|
|
'ERROR IN ELEMENT CONNECTIONS')
|
||
|
|
|
||
|
|
ENDIF
|
||
|
|
endif
|
||
|
|
ENDIF
|
||
|
|
if(IDDSW .EQ. 0) then
|
||
|
|
call backc(2)
|
||
|
|
endif
|
||
|
|
!ycw mar97 add for cross section
|
||
|
|
if(ICRS.ne.0) then
|
||
|
|
call plott(XPCS(1),YPCS(1),3)
|
||
|
|
call RRED
|
||
|
|
call plott(XPCS(2),YPCS(2),2)
|
||
|
|
do i=1,NCSNOD
|
||
|
|
xpl(1)=XCND(i)-0.04
|
||
|
|
ypl(1)=YCND(i)-0.04
|
||
|
|
xpl(2)=XCND(i)+0.04
|
||
|
|
ypl(2)=ypl(1)
|
||
|
|
xpl(3)=xpl(2)
|
||
|
|
ypl(3)=YCND(i)+0.04
|
||
|
|
xpl(4)=xpl(1)
|
||
|
|
ypl(4)=ypl(3)
|
||
|
|
xpl(5)=xpl(1)
|
||
|
|
ypl(5)=ypl(1)
|
||
|
|
call polyfl(xpl,ypl,5,1)
|
||
|
|
enddo
|
||
|
|
call RBLACK
|
||
|
|
endif
|
||
|
|
!ycw
|
||
|
|
250 continue
|
||
|
|
IF(NTRACT .GT. 0) THEN
|
||
|
|
DO KK=1,NTRACT
|
||
|
|
XLIN(KK)=CORD(ITRAC(KK),1)
|
||
|
|
YLIN(KK)=CORD(ITRAC(KK),2)
|
||
|
|
ENDDO
|
||
|
|
CALL RRED
|
||
|
|
!ipk jan01
|
||
|
|
CALL THICKL
|
||
|
|
CALL DASHLN(XLIN,YLIN,NTRAC,0)
|
||
|
|
!ipk jan01
|
||
|
|
CALL RBLACK
|
||
|
|
CALL THINL
|
||
|
|
call pltnod(ITRAC(1),0)
|
||
|
|
call pltnod(ITRAC(NTRACT),0)
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
IF (IPSW(8) .EQ. 1) CALL PGRID
|
||
|
|
|
||
|
|
!IPK JAN01
|
||
|
|
IF(IPSW(10) .EQ. 1) CALL PLOTCC
|
||
|
|
|
||
|
|
!ipk oct02
|
||
|
|
IF(IPSW(11) .EQ. 1) CALL PLOTCSTR
|
||
|
|
|
||
|
|
!ipk oct03
|
||
|
|
IF(IPSW(12) .EQ. 1) CALL PLOTCRSS(0)
|
||
|
|
|
||
|
|
if(ipsw(13) .eq. 1) call plotcrss(1)
|
||
|
|
|
||
|
|
IF(INREORD .EQ. 1) THEN
|
||
|
|
CALL PLOTORDS
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
IF(IMZ .NE. 1) THEN
|
||
|
|
CALL DOPLOT(IMZ)
|
||
|
|
ENDIF
|
||
|
|
CALL CHEXIT
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
!
|
||
|
|
!****************************************************************
|
||
|
|
!
|
||
|
|
SUBROUTINE PLTNOD(J,ICOL)
|
||
|
|
!
|
||
|
|
USE BLK1MOD
|
||
|
|
! INCLUDE 'BLK1.COM'
|
||
|
|
!
|
||
|
|
! Plot nodes on screen
|
||
|
|
!
|
||
|
|
HT = .20
|
||
|
|
IF (CORD(J,1) .LT. VDX) RETURN
|
||
|
|
X = CORD(J,1)
|
||
|
|
Y = CORD(J,2)
|
||
|
|
CALL PLOTT(X,Y,3)
|
||
|
|
CALL PLOTT(X,Y,2)
|
||
|
|
IF(ICOL .EQ. 0 .OR. ICOL .EQ. 1) THEN
|
||
|
|
Y = Y+0.07
|
||
|
|
FPN = J
|
||
|
|
ELSEIF(ICOL .EQ. 2) THEN
|
||
|
|
Y = Y+0.07
|
||
|
|
FPN = LAY(J)
|
||
|
|
IF(LAY(J) .EQ. -9999) GO TO 500
|
||
|
|
ELSE
|
||
|
|
!ipk jul02 Y = Y-0.11
|
||
|
|
Y = Y+0.10
|
||
|
|
!ipk jul02 FPN=WD(J)*10.
|
||
|
|
fpn=wd(j)
|
||
|
|
if(icrin .eq. 23) fpn=wd1(j)
|
||
|
|
ENDIF
|
||
|
|
IF(IJUN(J) .NE. 0) THEN
|
||
|
|
Y=Y-0.17*FLOAT(IJUN(J)-2)
|
||
|
|
ENDIF
|
||
|
|
IF(ICOL .LT. 1) THEN
|
||
|
|
CALL RRed
|
||
|
|
if(lock(j) .eq. 1) call rgreen
|
||
|
|
ELSE
|
||
|
|
CALL RBlack
|
||
|
|
ENDIF
|
||
|
|
IF(X .GT. 0. .AND. X .LT. HSIZE) THEN
|
||
|
|
IF(Y .GT. 0. .AND. Y .LT. 7.5) THEN
|
||
|
|
! ipk mar01
|
||
|
|
! ipk jul02
|
||
|
|
if(icol .lt. 0) then
|
||
|
|
call numbr(x,y,0.12,fpn,0.0,-icol)
|
||
|
|
else
|
||
|
|
CALL NUMBR(X,Y,0.15,FPN,0.0,-1)
|
||
|
|
endif
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
500 CONTINUE
|
||
|
|
CALL RBlue
|
||
|
|
!
|
||
|
|
END
|
||
|
|
!
|
||
|
|
!****************************************************************
|
||
|
|
!
|
||
|
|
!IPK JAN98 SUBROUTINE PLTELM(J)
|
||
|
|
SUBROUTINE PLTELM(J,IERC)
|
||
|
|
|
||
|
|
USE BLK1MOD
|
||
|
|
!ipk jan99
|
||
|
|
|
||
|
|
INCLUDE 'TXFRM.COM'
|
||
|
|
INCLUDE 'BFILES.I90'
|
||
|
|
!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
|
||
|
|
|
||
|
|
DIMENSION XLIN(9),YLIN(9),BLVL(9)
|
||
|
|
!
|
||
|
|
! INCLUDE 'BLK1.COM'
|
||
|
|
CHARACTER*1 IJNK
|
||
|
|
CHARACTER*80 LIND
|
||
|
|
!
|
||
|
|
! Plot elements already formed
|
||
|
|
!
|
||
|
|
imz=ierc
|
||
|
|
ierc=0
|
||
|
|
if(NBKFL .eq. 0) then
|
||
|
|
call rblue
|
||
|
|
else
|
||
|
|
call ryellow
|
||
|
|
call rblack
|
||
|
|
endif
|
||
|
|
IF (IMAT(J) .EQ. 0 ) RETURN
|
||
|
|
NCN = NCORN(J)
|
||
|
|
!
|
||
|
|
XXC = 0.
|
||
|
|
YYC = 0.
|
||
|
|
NLINP=0
|
||
|
|
IESKP(J)=1
|
||
|
|
DO 15 K=1,NCN
|
||
|
|
N = NOP(J,K)
|
||
|
|
IF (N .EQ. 0 .AND. MOD(K,2) .EQ. 1) THEN
|
||
|
|
CALL SETD(23)
|
||
|
|
! CALL CLSCRN()
|
||
|
|
!IPK JAN98 WRITE(*,*) ' Zero node corner node'
|
||
|
|
!IPK JAN98 WRITE(*,*) ' ELEM, NOP(ELEM,K) '
|
||
|
|
!IPK JAN98 WRITE(*,'(I5,I10,7I5)') J,(NOP(J,KK),KK=1,NCN)
|
||
|
|
WRITE(90,*) ' ELEM, NOP(ELEM,K) '
|
||
|
|
WRITE(90,'(I5,I10,7I5)') J,(NOP(J,KK),KK=1,NCN)
|
||
|
|
!IPK JAN98 WRITE(*,*) 'Press enter to exit'
|
||
|
|
!IPK JAN98 READ(*,'(A)') IJNK
|
||
|
|
!IPK JAN98 CALL Quit_Pgm
|
||
|
|
!IPK JAN98 STOP
|
||
|
|
IERC=IERC+1
|
||
|
|
do kk=1,8
|
||
|
|
nop(j,kk)=0
|
||
|
|
enddo
|
||
|
|
imat(j)=0
|
||
|
|
RETURN
|
||
|
|
ENDIF
|
||
|
|
!
|
||
|
|
! IF (N .EQ. 0 .OR. CORD(N,1) .LT. VDX) GOTO 15
|
||
|
|
IF (N .EQ. 0) GO TO 15
|
||
|
|
IF(MOD(K,2) .EQ. 1 .AND. CORD(N,1) .LT. VDX) GOTO 15
|
||
|
|
IF(CORD(N,1) .LT. VDX) THEN
|
||
|
|
IF(K .EQ. NCN) THEN
|
||
|
|
X=(CORD(NOP(J,K-1),1)+CORD(NOP(J,1),1))/2.
|
||
|
|
Y=(CORD(NOP(J,K-1),2)+CORD(NOP(J,1),1))/2.
|
||
|
|
ELSE
|
||
|
|
X=(CORD(NOP(J,K-1),1)+CORD(NOP(J,K+1),1))/2.
|
||
|
|
Y=(CORD(NOP(J,K-1),2)+CORD(NOP(J,K+1),1))/2.
|
||
|
|
ENDIF
|
||
|
|
ELSE
|
||
|
|
!
|
||
|
|
X = CORD(N,1)
|
||
|
|
Y = CORD(N,2)
|
||
|
|
ENDIF
|
||
|
|
IF(X .GT. 0. .AND. X .LT. HSIZE) THEN
|
||
|
|
IF(Y .GT. 0. .AND. Y .LT. 7.5) THEN
|
||
|
|
IESKP(J)=0
|
||
|
|
GO TO 16
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
15 END DO
|
||
|
|
16 CONTINUE
|
||
|
|
!
|
||
|
|
IF(IESKP(J) .EQ. 1) GO TO 26
|
||
|
|
|
||
|
|
if(ipsw(7) .eq. 1 .and. iqsw(2) .GT. 0) then
|
||
|
|
IF(IQSW(2) .EQ. 1) ittmp=imat(j)
|
||
|
|
IF(IQSW(2) .EQ. 2) ittmp=igrpser(j)
|
||
|
|
IF(ITTMP .GT. 900 ) THEN
|
||
|
|
ICCT=MOD(ITTMP+1,10)+4
|
||
|
|
ELSE
|
||
|
|
icct=MOD(ittmp,10)+4
|
||
|
|
ENDIF
|
||
|
|
if(imz .ne. 2) then
|
||
|
|
call fillemc(j,icct)
|
||
|
|
endif
|
||
|
|
endif
|
||
|
|
|
||
|
|
DO 25 K=1,NCN
|
||
|
|
N = NOP(J,K)
|
||
|
|
!
|
||
|
|
IF (N .EQ. 0) go to 25
|
||
|
|
IF (CORD(N,1) .LT. VDX) GOTO 25
|
||
|
|
!
|
||
|
|
X = CORD(N,1)
|
||
|
|
Y = CORD(N,2)
|
||
|
|
!
|
||
|
|
IF (NCN .NE. 5 .OR. K .LT. 5) THEN
|
||
|
|
IF (MOD(K,2) .EQ. 1) THEN
|
||
|
|
XXC = XXC + X
|
||
|
|
YYC = YYC + Y
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
NLINP=NLINP+1
|
||
|
|
!
|
||
|
|
XLIN(NLINP)=X
|
||
|
|
YLIN(NLINP)=Y
|
||
|
|
BLVL(NLINP)=WD(N)
|
||
|
|
IF (K .EQ. 1) THEN
|
||
|
|
X1 = X
|
||
|
|
Y1 = Y
|
||
|
|
ENDIF
|
||
|
|
25 END DO
|
||
|
|
IF(NCN .GT. 5) THEN
|
||
|
|
NLINP=NLINP+1
|
||
|
|
XLIN(NLINP)=X1
|
||
|
|
YLIN(NLINP)=Y1
|
||
|
|
BLVL(NLINP)=WD(NOP(J,1))
|
||
|
|
ENDIF
|
||
|
|
if(i3dview .eq. 1) then
|
||
|
|
do k=1,nlinp
|
||
|
|
YLIN(K)=YLIN(K)+(BLVL(K)-VRTORIG)*COS(VANG/57.29578)/VRTSCAL
|
||
|
|
enddo
|
||
|
|
endif
|
||
|
|
!ipkoct93
|
||
|
|
if(ipsw(4) .eq. 1) then
|
||
|
|
if(ncn .eq. 8 .or. imat(j) .lt. 901) then
|
||
|
|
CALL DASHLN(XLIN,YLIN,NLINP,0)
|
||
|
|
! write(155,'(2i6,24f12.3)') j,ncn,(xlin(k),ylin(k),blvl(k),k=1,ncn)
|
||
|
|
endif
|
||
|
|
endif
|
||
|
|
! IF(IMAT(J) .LT. 901 .AND. IPSW(4) .EQ. 1)
|
||
|
|
! + CALL DASHLN(XLIN,YLIN,NLINP,0)
|
||
|
|
!ipkoct93
|
||
|
|
!
|
||
|
|
! Plot elem number at center if IPSW(5) = 1
|
||
|
|
!
|
||
|
|
CALL RCyan
|
||
|
|
IF (NCN .EQ. 3 .OR. NCN .EQ. 5) NCN = 4
|
||
|
|
XC(J) = 2.*XXC/NCN
|
||
|
|
YC(J) = 2.*YYC/NCN
|
||
|
|
! IF(IMAT(J) .GT. 900 ) THEN
|
||
|
|
IF(IMAT(J) .GT. 900 .and. ncorn(j) .ne. 8) THEN
|
||
|
|
CALL RBlue
|
||
|
|
RETURN
|
||
|
|
ENDIF
|
||
|
|
!ipk feb99 add element type option
|
||
|
|
IF(IPSW(5) .EQ. 1 .or. ipsw(7) .eq. 1) THEN
|
||
|
|
HT = .20
|
||
|
|
if(ipsw(5) .eq. 1) then
|
||
|
|
FPN = J
|
||
|
|
!ipk mar00 fix imat display bug
|
||
|
|
elseif((iqsw(1) .gt. 0) .or. (iqsw(1) .eq. 0 .and. iqsw(2) .eq. 0) ) then
|
||
|
|
CALL RBLACK
|
||
|
|
if(iqsw(1) .eq. 1) fpn=imat(j)
|
||
|
|
if(iqsw(1) .eq. 2) fpn=igrpser(j)
|
||
|
|
! elseif(iqsw(2) .eq. 1) then
|
||
|
|
! CALL RBLACK
|
||
|
|
! fpn=imat(j)
|
||
|
|
else
|
||
|
|
go to 30
|
||
|
|
endif
|
||
|
|
IF(XC(J) .GT. 0. .AND. XC(J) .LT. HSIZE) THEN
|
||
|
|
IF(YC(J) .GT. 0. .AND. YC(J) .LT. 7.5) THEN
|
||
|
|
!ipkoct93
|
||
|
|
! IF(IMAT(J) .LT. 901) CALL NUMBR(XC(J),YC(J),HT,FPN,0.0,-1)
|
||
|
|
! ipk mar01
|
||
|
|
!ipk jun02
|
||
|
|
xxc=xc(j)
|
||
|
|
yyc=yc(j)
|
||
|
|
CALL NUMBR(XXC,YYC,0.15,FPN,0.0,-1)
|
||
|
|
ENDIF
|
||
|
|
! elseif(iqsw(2) .eq. 1) then
|
||
|
|
! CALL RBLACK
|
||
|
|
! fpn=imat(j)
|
||
|
|
endif
|
||
|
|
30 continue
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
!ipk jan99 add plot of 1-d element widths
|
||
|
|
if(ncorn(j) .eq. 3 .or. ncorn(j) .eq. 5) then
|
||
|
|
ncn=3
|
||
|
|
n1=nop(j,1)
|
||
|
|
n2=nop(j,3)
|
||
|
|
!
|
||
|
|
!...... first for widths
|
||
|
|
|
||
|
|
IF(IPW1 .EQ. 1) THEN
|
||
|
|
wd11=width(n1)/txscal
|
||
|
|
wd2=width(n2)/txscal
|
||
|
|
ELSE
|
||
|
|
IF(NRIVCR1(N1) .EQ. 0 .AND. NRIVCR2(N1) .EQ. 0) RETURN
|
||
|
|
IF(NRIVCR1(N2) .EQ. 0 .AND. NRIVCR2(N2) .EQ. 0) RETURN
|
||
|
|
BT1= &
|
||
|
|
CRSDAT(NRIVCR1(N1),1,1)*WTRIVCR1(N1)+ &
|
||
|
|
CRSDAT(NRIVCR2(N1),1,1)*WTRIVCR2(N1)
|
||
|
|
BT2= &
|
||
|
|
CRSDAT(NRIVCR1(N2),1,1)*WTRIVCR1(N2)+ &
|
||
|
|
CRSDAT(NRIVCR2(N2),1,1)*WTRIVCR2(N2)
|
||
|
|
H1=WIDEL-BT1
|
||
|
|
H2=WIDEL-BT2
|
||
|
|
CALL INTERPWLV(N1,H1,AR1,WR1,DWR1)
|
||
|
|
CALL INTERPWLV(N2,H2,AR2,WR2,DWR2)
|
||
|
|
WIDTH(N1)=WR1
|
||
|
|
WIDTH(N2)=WR2
|
||
|
|
IF(IPW1 .EQ. 2) THEN
|
||
|
|
WD11=WR1*WIDSCL/TXSCAL
|
||
|
|
WD2=WR2*WIDSCL/TXSCAL
|
||
|
|
ELSE
|
||
|
|
WD11=AR1*WIDSCL/TXSCAL
|
||
|
|
WD2=AR2*WIDSCL/TXSCAL
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
ENDIF
|
||
|
|
if(wd11 .gt. 0. .and. wd2 .gt. 0.) then
|
||
|
|
x1= cord(n1,1)
|
||
|
|
x2= cord(n2,1)
|
||
|
|
y1= cord(n1,2)
|
||
|
|
y2= cord(n2,2)
|
||
|
|
eldir=atan2(y2-y1,x2-x1)
|
||
|
|
elnorm=eldir-1.5708
|
||
|
|
xlin(1)=x1+cos(elnorm)*wd11/2.
|
||
|
|
xlin(5)=xlin(1)
|
||
|
|
xlin(4)=x1-cos(elnorm)*wd11/2.
|
||
|
|
xlin(2)=x2+cos(elnorm)*wd2/2.
|
||
|
|
xlin(3)=x2-cos(elnorm)*wd2/2.
|
||
|
|
ylin(1)=y1+sin(elnorm)*wd11/2.
|
||
|
|
ylin(5)=ylin(1)
|
||
|
|
ylin(4)=y1-sin(elnorm)*wd11/2.
|
||
|
|
ylin(2)=y2+sin(elnorm)*wd2/2.
|
||
|
|
ylin(3)=y2-sin(elnorm)*wd2/2.
|
||
|
|
call dashln(xlin,ylin,5,0)
|
||
|
|
endif
|
||
|
|
|
||
|
|
!...... then for storage widths
|
||
|
|
|
||
|
|
wd11=(wids(n1)+width(n1))/txscal
|
||
|
|
wd2=(wids(n2)+width(n2))/txscal
|
||
|
|
if(wids(n1) .gt. 0. .and. wids(n2) .gt. 0.) then
|
||
|
|
x1= cord(n1,1)
|
||
|
|
x2= cord(n2,1)
|
||
|
|
y1= cord(n1,2)
|
||
|
|
y2= cord(n2,2)
|
||
|
|
eldir=atan2(y2-y1,x2-x1)
|
||
|
|
elnorm=eldir-1.5708
|
||
|
|
xlin(1)=x1+cos(elnorm)*wd11/2.
|
||
|
|
xlin(5)=xlin(1)
|
||
|
|
xlin(4)=x1-cos(elnorm)*wd11/2.
|
||
|
|
xlin(2)=x2+cos(elnorm)*wd2/2.
|
||
|
|
xlin(3)=x2-cos(elnorm)*wd2/2.
|
||
|
|
ylin(1)=y1+sin(elnorm)*wd11/2.
|
||
|
|
ylin(5)=ylin(1)
|
||
|
|
ylin(4)=y1-sin(elnorm)*wd11/2.
|
||
|
|
ylin(2)=y2+sin(elnorm)*wd2/2.
|
||
|
|
ylin(3)=y2-sin(elnorm)*wd2/2.
|
||
|
|
call dashln(xlin,ylin,5,1)
|
||
|
|
endif
|
||
|
|
endif
|
||
|
|
|
||
|
|
|
||
|
|
CALL RBlue
|
||
|
|
26 CONTINUE
|
||
|
|
!
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
!
|
||
|
|
!****************************************************************
|
||
|
|
!
|
||
|
|
SUBROUTINE PLTMAP
|
||
|
|
!
|
||
|
|
USE BLKMAP
|
||
|
|
USE BLK1MOD
|
||
|
|
! INCLUDE 'BLK1.COM'
|
||
|
|
!
|
||
|
|
! Plot map of input data
|
||
|
|
!
|
||
|
|
! Determine how long each line is
|
||
|
|
!
|
||
|
|
JS=1
|
||
|
|
!
|
||
|
|
K=0
|
||
|
|
CALL RCyan
|
||
|
|
DO 20 J=1,MAXPTS
|
||
|
|
MLEN=J-JS
|
||
|
|
! write(90,*) 'j,mlen',j,mlen,cmap(j,1),k+1,lintyp(k+1),vdx
|
||
|
|
! write(123,*) 'j,mlen',j,mlen,cmap(j,1),k+1,lintyp(k+1),vdx
|
||
|
|
IF(XMAP(J) .LE. VDX .or. j .eq. maxpts) THEN
|
||
|
|
if(j .eq. maxpts .and. xmap(j) .gt. vdx) mlen=mlen+1
|
||
|
|
!
|
||
|
|
! Now draw it.
|
||
|
|
!
|
||
|
|
K=K+1
|
||
|
|
IF(MLEN .GT. 1) THEN
|
||
|
|
LTP=LINTYP(K)
|
||
|
|
!ipk oct96
|
||
|
|
if(icolon(ltp+1) .eq. 1) then
|
||
|
|
|
||
|
|
IF(LTP .NE. 2) THEN
|
||
|
|
!ipk oct96 IF(LTP .LT. 2) THEN
|
||
|
|
CALL RRed
|
||
|
|
|
||
|
|
! write(90,*) 'at nwpen ltp',ltp
|
||
|
|
IF(LTP .GT. 0) CALL NWPEN(2*LTP+1)
|
||
|
|
IF(LTP .GT. 2) LTP=0
|
||
|
|
CALL DBDASHLN(cmap(js,1),cmap(js,2),MLEN,LTP)
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
IF(MLEN .EQ. 0 .AND. LINTYP(K) .EQ. -999) GO TO 30
|
||
|
|
JS=J+1
|
||
|
|
ENDIF
|
||
|
|
20 CONTINUE
|
||
|
|
30 CONTINUE
|
||
|
|
CALL RBlue
|
||
|
|
RETURN
|
||
|
|
!
|
||
|
|
END
|
||
|
|
!
|
||
|
|
!***********************************************************************
|
||
|
|
!
|
||
|
|
SUBROUTINE SCLMAP
|
||
|
|
!
|
||
|
|
! Scale map coordinates for plotting
|
||
|
|
! Keep track and update information for mapping
|
||
|
|
! screen coordinates back to user coordinates
|
||
|
|
!
|
||
|
|
USE BLKMAP
|
||
|
|
USE BLK1MOD
|
||
|
|
! INCLUDE 'BLK1.COM'
|
||
|
|
!
|
||
|
|
|
||
|
|
INCLUDE 'TXFRM.COM'
|
||
|
|
!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
|
||
|
|
!
|
||
|
|
!ipk may94 moved to blk1.com DATA XREF,YREF / 0.0, 0.0 /
|
||
|
|
!
|
||
|
|
DO 10 J=1,MAXPTS
|
||
|
|
IF (CMAP(J,1) .LT. VDX) GOTO 10
|
||
|
|
CMAP(J,1) = (CMAP(J,1)-XMIN)/PSCALE
|
||
|
|
CMAP(J,2) = (CMAP(J,2)-YMIN)/PSCALE
|
||
|
|
10 END DO
|
||
|
|
!
|
||
|
|
XREF = (XREF-XMIN)/PSCALE
|
||
|
|
YREF = (YREF-YMIN)/PSCALE
|
||
|
|
IF(IASPCT .EQ. 1) THEN
|
||
|
|
VRTSCAL=VRTSCAL*PSCALE
|
||
|
|
ENDIF
|
||
|
|
TXSCAL = TXSCAL*PSCALE
|
||
|
|
XS = XREF*TXSCAL
|
||
|
|
YS = YREF*TXSCAL
|
||
|
|
write(90,*) ' The line that follows gives the values used for a te&
|
||
|
|
&mporary origin and scale'
|
||
|
|
write(90,6000) xs,ys,txscal
|
||
|
|
6000 format(3f15.4)
|
||
|
|
!
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
!
|
||
|
|
!***********************************************************************
|
||
|
|
!
|
||
|
|
SUBROUTINE SCLCRD
|
||
|
|
!
|
||
|
|
! Scale coordinates for plotting
|
||
|
|
! Keep track and update information for mapping
|
||
|
|
! screen coordinates back to user coordinates
|
||
|
|
!
|
||
|
|
USE BLK1MOD
|
||
|
|
! INCLUDE 'BLK1.COM'
|
||
|
|
!
|
||
|
|
REAL*8 ANGPT,ANGNEW,DRAD,DVANG,DVANGOLD
|
||
|
|
|
||
|
|
DATA PI/3.14159265/,ITIME/0/,DRAD/57.29577957855/
|
||
|
|
IF(ITIME .EQ. 0) THEN
|
||
|
|
VANGOLD=90.
|
||
|
|
VANG=90.
|
||
|
|
HANG=0.
|
||
|
|
HANGOLD=0.
|
||
|
|
! DRAD=180./PI
|
||
|
|
ITIME=1
|
||
|
|
ENDIF
|
||
|
|
DVANG=VANG
|
||
|
|
DVANGOLD=VANGOLD
|
||
|
|
!
|
||
|
|
|
||
|
|
! ROTATE BACK IF NEEDED
|
||
|
|
|
||
|
|
|
||
|
|
IF((HANGOLD .EQ. HANG) .AND. (VANGOLD .EQ. VANG)) GO TO 5
|
||
|
|
IF(HANGOLD .NE. 0. .OR. VANGOLD .NE. 90.) THEN
|
||
|
|
IF(NP .GT. 0) THEN
|
||
|
|
DO J=1,NP
|
||
|
|
IF (CORD(J,1) .GE. VDX) THEN
|
||
|
|
|
||
|
|
IF(VANGOLD .LT. 90.) THEN
|
||
|
|
CORD(J,2)=4.+(CORD(J,2)-4.)/DSIN(DVANGOLD/DRAD)
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
ANGPT=DATAN2D(CORD(J,2)-4,CORD(J,1)-5.)
|
||
|
|
VLEN=SQRT((CORD(J,1)-5.)**2+(CORD(J,2)-4.)**2)
|
||
|
|
ANGNEW=ANGPT+HANGOLD
|
||
|
|
! IF(J .EQ. 1) THEN
|
||
|
|
! WRITE(90,*) 'ROTBACK',ANGPT,VLEN,ANGNEW,CORD(J,1),CORD(J,2)
|
||
|
|
! ENDIF
|
||
|
|
CORD(J,1)=5.+VLEN*DCOS(ANGNEW/DRAD)
|
||
|
|
CORD(J,2)=4.+VLEN*DSIN(ANGNEW/DRAD)
|
||
|
|
! IF(J .EQ. 1) THEN
|
||
|
|
! WRITE(90,*) CORD(J,1),CORD(J,2)
|
||
|
|
! ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
5 CONTINUE
|
||
|
|
|
||
|
|
IF(NP .GT. 0) THEN
|
||
|
|
DO 10 J=1,NP
|
||
|
|
IF (CORD(J,1) .LT. VDX) GOTO 10
|
||
|
|
CORD(J,1) = (CORD(J,1)-XMIN)/PSCALE
|
||
|
|
CORD(J,2) = (CORD(J,2)-YMIN)/PSCALE
|
||
|
|
10 CONTINUE
|
||
|
|
ENDIF
|
||
|
|
!
|
||
|
|
! ROTATE IF NEEDED
|
||
|
|
|
||
|
|
IF((HANGOLD .EQ. HANG) .AND. (VANGOLD .EQ. VANG)) GO TO 15
|
||
|
|
|
||
|
|
IF(HANG .NE. 0 .OR. VANG .LT. 90.) THEN
|
||
|
|
IF(NP .GT. 0) THEN
|
||
|
|
DO J=1,NP
|
||
|
|
IF (CORD(J,1) .GE. VDX) THEN
|
||
|
|
ANGPT=DATAN2D(CORD(J,2)-4,CORD(J,1)-5.)
|
||
|
|
VLEN=SQRT((CORD(J,1)-5.)**2+(CORD(J,2)-4.)**2)
|
||
|
|
ANGNEW=ANGPT-HANG
|
||
|
|
! IF(J .EQ. 1) THEN
|
||
|
|
! WRITE(90,*) 'ROT',ANGPT,VLEN,ANGNEW,CORD(J,1),CORD(J,2)
|
||
|
|
! ENDIF
|
||
|
|
CORD(J,1)=5.+VLEN*DCOS(ANGNEW/DRAD)
|
||
|
|
CORD(J,2)=4.+VLEN*DSIN(ANGNEW/DRAD)
|
||
|
|
IF(VANG .LT. 90.) THEN
|
||
|
|
CORD(J,2)=4.+(CORD(J,2)-4.)*DSIN(DVANG/DRAD)
|
||
|
|
ENDIF
|
||
|
|
! IF(J .EQ. 1) THEN
|
||
|
|
! WRITE(90,*) CORD(J,1),CORD(J,2)
|
||
|
|
! ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
HANGOLD=HANG
|
||
|
|
VANGOLD=VANG
|
||
|
|
|
||
|
|
15 CONTINUE
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
!
|
||
|
|
END
|
||
|
|
SUBROUTINE BOX(HEAD,NSIZ)
|
||
|
|
!
|
||
|
|
! Routine to draw NSIZ header boxes at top of page with the HEAD label
|
||
|
|
!
|
||
|
|
CHARACTER*8 HEAD(*)
|
||
|
|
XSY=0.
|
||
|
|
XLMT=FLOAT(NSIZ)
|
||
|
|
DO 200 N=1,NSIZ
|
||
|
|
CALL SYMBL(XSY,7.65,0.20,HEAD(N),0.0, 8)
|
||
|
|
XSY=XSY+1.0
|
||
|
|
200 CONTINUE
|
||
|
|
!
|
||
|
|
! Draw box around selections
|
||
|
|
!
|
||
|
|
CALL PLOTT(0.0,7.0,3)
|
||
|
|
CALL PLOTT(XLMT,7.0,2)
|
||
|
|
CALL PLOTT(XLMT,7.495,2)
|
||
|
|
CALL PLOTT(0.0,7.495,2)
|
||
|
|
CALL PLOTT(0.0,7.0,2)
|
||
|
|
XPT=0.
|
||
|
|
DO 205 I=1,NSIZ
|
||
|
|
XPT=XPT+1.0
|
||
|
|
CALL PLOTT(XPT,7.0,3)
|
||
|
|
CALL PLOTT(XPT,7.495,2)
|
||
|
|
205 CONTINUE
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
SUBROUTINE BOXR(NBOX)
|
||
|
|
SAVE
|
||
|
|
!
|
||
|
|
! Routine to draw header box at top right of page with the HEAD label
|
||
|
|
!
|
||
|
|
CHARACTER*24 HEAD
|
||
|
|
CHARACTER*16 HEAD1
|
||
|
|
CHARACTER*24 HEAD2
|
||
|
|
DIMENSION X(5),Y(5)
|
||
|
|
DATA HEAD /' (z)oom r(d)raw (q)uit '/
|
||
|
|
DATA HEAD1 /' r(d)raw (q)uit '/
|
||
|
|
DATA HEAD2 /' (n)ext (z)oom (q)uit '/
|
||
|
|
!
|
||
|
|
! Draw box around selections
|
||
|
|
!
|
||
|
|
NBX=IABS(NBOX)
|
||
|
|
XLEFT=10-NBX
|
||
|
|
Y(1)=7.5
|
||
|
|
Y(2)=7.5
|
||
|
|
Y(3)=7.995
|
||
|
|
Y(4)=7.995
|
||
|
|
Y(5)=7.5
|
||
|
|
! CALL PLOTT(XLEFT,7.0,3)
|
||
|
|
! CALL PLOTT(10.0,7.0,2)
|
||
|
|
! CALL PLOTT(10.0,7.495,2)
|
||
|
|
! CALL PLOTT(XLEFT,7.495,2)
|
||
|
|
! CALL PLOTT(XLEFT,7.0,2)
|
||
|
|
! IF(NBOX .GT. 1) THEN
|
||
|
|
DO 200 K=1,NBX
|
||
|
|
X(1)=XLEFT
|
||
|
|
X(4)=XLEFT
|
||
|
|
X(5)=XLEFT
|
||
|
|
XLEFT=XLEFT+1.0
|
||
|
|
X(2)=XLEFT
|
||
|
|
X(3)=XLEFT
|
||
|
|
IBLK=4
|
||
|
|
CALL POLYFL(X,Y,5,IBLK)
|
||
|
|
CALL RBLACK
|
||
|
|
CALL PLOTT(X(1),Y(1),3)
|
||
|
|
CALL PLOTT(X(2),Y(2),2)
|
||
|
|
CALL PLOTT(X(3),Y(3),2)
|
||
|
|
CALL PLOTT(X(4),Y(4),2)
|
||
|
|
CALL PLOTT(X(1),Y(1),2)
|
||
|
|
! DO 200 K=1,NBOX-1
|
||
|
|
! XLEFT=XLEFT+1.
|
||
|
|
! CALL PLOTT(XLEFT,7.0,3)
|
||
|
|
! CALL PLOTT(XLEFT,7.495,2)
|
||
|
|
200 END DO
|
||
|
|
! ENDIF
|
||
|
|
!
|
||
|
|
! Establish label
|
||
|
|
!
|
||
|
|
IF(NBOX .EQ. 3) THEN
|
||
|
|
CALL SYMBL(7.0,7.65,0.20,HEAD,0.0,24)
|
||
|
|
ELSEIF(NBOX .EQ. -3) THEN
|
||
|
|
CALL SYMBL(7.0,7.65,0.20,HEAD2,0.0,24)
|
||
|
|
ELSEIF(NBOX .EQ. 2) THEN
|
||
|
|
CALL SYMBL(8.0,7.65,0.20,HEAD1,0.0,16)
|
||
|
|
ENDIF
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
!
|
||
|
|
!
|
||
|
|
SUBROUTINE OUTLN
|
||
|
|
!-
|
||
|
|
!......OUTLN DRAWS BOUNDARIES FOR THE SYSTEM
|
||
|
|
!-
|
||
|
|
USE BLK1MOD
|
||
|
|
! INCLUDE 'BLK1.COM'
|
||
|
|
!
|
||
|
|
! INTEGER*2 MSN
|
||
|
|
! COMMON /MID/ MSN(MAXP)
|
||
|
|
!
|
||
|
|
DATA IFIRST / 1 /
|
||
|
|
!-
|
||
|
|
!-
|
||
|
|
! DATA MAXB/MAXE/
|
||
|
|
YMAXX = 7.50
|
||
|
|
!-
|
||
|
|
!-.....PLOT BOUNDARY OUTLINE.....
|
||
|
|
!-
|
||
|
|
! 100 DO 110 J=1,MAXB
|
||
|
|
! NBP(J) = 0
|
||
|
|
! 110 CONTINUE
|
||
|
|
!
|
||
|
|
IF (IFIRST .EQ. 1) GOTO 185
|
||
|
|
IFIRST = 0
|
||
|
|
!
|
||
|
|
NPTS=-1
|
||
|
|
! READ(5,5020) NPTS
|
||
|
|
! 5020 FORMAT( 16I5 )
|
||
|
|
IF( NPTS .EQ. 0 ) RETURN
|
||
|
|
185 CONTINUE
|
||
|
|
DO 186 I=1,NP
|
||
|
|
186 MSN(I) = 0
|
||
|
|
DO 187 J=1,NE
|
||
|
|
IF(IESKP(J) .NE. 0) GO TO 187
|
||
|
|
IF (IMAT(J) .LE. 0) GOTO 187
|
||
|
|
IF (IMAT(J) .GT. 900) GO TO 187
|
||
|
|
NCN = 6
|
||
|
|
IF (NOP(J,7) .NE. 0) NCN = 8
|
||
|
|
IF (NOP(J,6) .EQ. 0) NCN=3
|
||
|
|
DO 188 K=2,NCN,2
|
||
|
|
N = NOP(J,K)
|
||
|
|
if(n .gt. 0) then
|
||
|
|
MSN(N) = MSN(N) + 1
|
||
|
|
endif
|
||
|
|
188 CONTINUE
|
||
|
|
187 END DO
|
||
|
|
DO 195 J = 1, NE
|
||
|
|
IF(IESKP(J) .NE. 0) GO TO 195
|
||
|
|
IF(IMAT(J) .LE. 0) GO TO 195
|
||
|
|
!ipkoct93
|
||
|
|
! IF(IMAT(J) .GT. 900) GO TO 195
|
||
|
|
IF(IMAT(J) .GT. 900 .and. nop(j,7) .eq. 0) GO TO 195
|
||
|
|
NCN = 6
|
||
|
|
IF (NOP(J,7) .NE. 0) NCN = 8
|
||
|
|
IF (NOP(J,6) .EQ. 0) NCN=3
|
||
|
|
DO 194 K = 2,NCN , 2
|
||
|
|
L=NOP(J,K)
|
||
|
|
IF(L .EQ. 0) GO TO 194
|
||
|
|
IF(MSN(L) .EQ. 1) THEN
|
||
|
|
N1 = NOP(J,K-1)
|
||
|
|
N2 = NOP(J,K)
|
||
|
|
N3 = MOD(K+1,NCN)
|
||
|
|
IF(N3 .EQ. 0) N3=NCN
|
||
|
|
N3 = NOP(J,N3)
|
||
|
|
X1 = CORD(N1,1)
|
||
|
|
Y1 = CORD(N1,2)
|
||
|
|
X2 = CORD(N2,1)
|
||
|
|
Y2 = CORD(N2,2)
|
||
|
|
X3 = CORD(N3,1)
|
||
|
|
Y3 = CORD(N3,2)
|
||
|
|
CALL FIT(X1,Y1,X2,Y2,X3,Y3)
|
||
|
|
ENDIF
|
||
|
|
194 CONTINUE
|
||
|
|
195 END DO
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
SUBROUTINE AROHD(XPAGE,YPAGE,XTIP,YTIP,AHLEN,AHWID,ICODE)
|
||
|
|
!*********************************** .....AROHD.....
|
||
|
|
SAVE
|
||
|
|
!
|
||
|
|
IF(AHWID.LE.0.001) AHWID=AHLEN
|
||
|
|
I1=ICODE/10+3
|
||
|
|
IF(I1.NE.3) I1=2
|
||
|
|
KK=MOD(ICODE,10)
|
||
|
|
I2=2
|
||
|
|
I3=2
|
||
|
|
I4=2
|
||
|
|
IF(KK.EQ.2) GO TO 10
|
||
|
|
IF(KK.NE.4) GO TO 20
|
||
|
|
I3=3
|
||
|
|
GO TO 10
|
||
|
|
20 IF(KK.NE.5) GO TO 30
|
||
|
|
I2=3
|
||
|
|
I3=3
|
||
|
|
GO TO 10
|
||
|
|
30 IF(KK.NE.8) GO TO 10
|
||
|
|
I2=3
|
||
|
|
I3=3
|
||
|
|
I4=4
|
||
|
|
10 CONTINUE
|
||
|
|
CALL PLOTT(XPAGE,YPAGE,3)
|
||
|
|
CALL PLOTT(XTIP,YTIP,I1)
|
||
|
|
TX=XTIP-XPAGE
|
||
|
|
TY=YTIP-YPAGE
|
||
|
|
XLEN=SQRT(TX**2+TY**2)
|
||
|
|
IF(XLEN .GT. 0.001) GO TO 200
|
||
|
|
XLEN=0.001
|
||
|
|
IF(ABS(TX) .LT. 0.001) TX=SIGN(0.001,TX)
|
||
|
|
IF(ABS(TY) .LT. 0.001) TY=SIGN(0.001,TY)
|
||
|
|
200 CONTINUE
|
||
|
|
TA=AHLEN/XLEN
|
||
|
|
XX=XTIP-TA*TX
|
||
|
|
YY=YTIP-TA*TY
|
||
|
|
AH=(AHWID/2.)**2
|
||
|
|
DY=SQRT(AH*TX**2/(TX**2+TY**2))
|
||
|
|
DY = SIGN(DY,TX)
|
||
|
|
DX=SQRT(AH*TY**2/(TX**2+TY**2))
|
||
|
|
DX = SIGN(DX,TY)
|
||
|
|
X1=XX+DX
|
||
|
|
X2=XX-DX
|
||
|
|
Y1=YY+DY
|
||
|
|
Y2=YY-DY
|
||
|
|
CALL PLOTT(X2,Y1,I2)
|
||
|
|
CALL PLOTT(X1,Y2,I3)
|
||
|
|
CALL PLOTT(XTIP,YTIP,I4)
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
!
|
||
|
|
!$$$ AUG 1987
|
||
|
|
! SUBROUTINE TEST(X,Y,IG)
|
||
|
|
!
|
||
|
|
!...... Routine to that plot is on paper
|
||
|
|
!
|
||
|
|
! SAVE
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! IG=0
|
||
|
|
! IF(X .LT. 0. ) RETURN
|
||
|
|
! IF(X .GT. 10.) RETURN
|
||
|
|
! IF(Y .LT. 0. ) RETURN
|
||
|
|
! IF(Y .GT. 7.0) RETURN
|
||
|
|
! IG=1
|
||
|
|
! RETURN
|
||
|
|
! END
|
||
|
|
!
|
||
|
|
SUBROUTINE FIT(X1,Y1,X2,Y2,X3,Y3)
|
||
|
|
SAVE
|
||
|
|
!
|
||
|
|
INTEGER I2,I3,IG
|
||
|
|
common /tek/ itek
|
||
|
|
|
||
|
|
DATA I2/2/,I3/3/
|
||
|
|
NPTS = 7
|
||
|
|
DS = 1.0/FLOAT(NPTS)
|
||
|
|
S = 0.0
|
||
|
|
! IG=0
|
||
|
|
! CALL TEST(X1,Y1,IT)
|
||
|
|
! IF(IT .GT. 0) THEN
|
||
|
|
CALL PLOTT(X1,Y1,I3)
|
||
|
|
IG=I3
|
||
|
|
! ENDIF
|
||
|
|
|
||
|
|
dx3 = x1-x3
|
||
|
|
dx2 = x1-x2
|
||
|
|
dy3 = y1-y3
|
||
|
|
dy2 = y1-y2
|
||
|
|
if (abs(dx2) .le. 1.E-8) dx2 = 1.E-8
|
||
|
|
if (abs(dx3) .le. 2.E-8) dx3 = 2.E-8
|
||
|
|
! call test(x3,y3,itt)
|
||
|
|
if (abs(dy3/dx3 - dy2/dx2) .le. abs(.01*dy2/dx2)) then
|
||
|
|
! .and.
|
||
|
|
! + itt .gt. 0 .and. it .gt. 0) then
|
||
|
|
call plott(x3,y3,i2)
|
||
|
|
else
|
||
|
|
|
||
|
|
DO 100 J = 1, NPTS
|
||
|
|
S = S + DS
|
||
|
|
XN1 = 1.0-3.0*S+2.0*S**2
|
||
|
|
XN2 = 4.0*S*(1.0-S)
|
||
|
|
XN3 = S*(2.0*S-1.0)
|
||
|
|
X= XN1*X1 + XN2*X2 + XN3*X3
|
||
|
|
Y = XN1*Y1 + XN2*Y2 + XN3*Y3
|
||
|
|
! CALL TEST(X,Y,IT)
|
||
|
|
! IF(IT .GT. 0) THEN
|
||
|
|
! IF(IG .EQ. 0) THEN
|
||
|
|
! IG=I3
|
||
|
|
! ELSE
|
||
|
|
IG=I2
|
||
|
|
! ENDIF
|
||
|
|
CALL PLOTT(X,Y,IG)
|
||
|
|
! ELSE
|
||
|
|
! IG=0
|
||
|
|
! ENDIF
|
||
|
|
100 END DO
|
||
|
|
endif
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
!
|
||
|
|
!****************************************************************
|
||
|
|
!
|
||
|
|
SUBROUTINE PGRID
|
||
|
|
!
|
||
|
|
! Form rectangular grid for guide lines by filling map arrays
|
||
|
|
!
|
||
|
|
USE BLK1MOD
|
||
|
|
! INCLUDE 'BLK1.COM'
|
||
|
|
!
|
||
|
|
|
||
|
|
INCLUDE 'TXFRM.COM'
|
||
|
|
|
||
|
|
!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
|
||
|
|
!
|
||
|
|
DIMENSION XG(2),YG(2)
|
||
|
|
!
|
||
|
|
DATA IFIRST / 1 /
|
||
|
|
!
|
||
|
|
IF (IFIRST .EQ. 1) THEN
|
||
|
|
DX = 10.
|
||
|
|
DY = 10.
|
||
|
|
X0 = -100.
|
||
|
|
!ipk sep94 update to 7.5 size Y0 = -70.
|
||
|
|
Y0 = -75.
|
||
|
|
X9 = HSIZE*10.
|
||
|
|
!ipk sep94 update to 7.5 size Y9 = 70.
|
||
|
|
Y9 = 75.
|
||
|
|
!
|
||
|
|
IF (XMIN .GT. -VDX) THEN
|
||
|
|
XMIN = -100.
|
||
|
|
XMAX = -XMIN
|
||
|
|
IPSW(8) = 1
|
||
|
|
ENDIF
|
||
|
|
IF (YMIN .GT. -VDX) THEN
|
||
|
|
!ipk sep94 update to 7.5 size YMIN = -70.
|
||
|
|
YMIN = -75.
|
||
|
|
YMAX = -YMIN
|
||
|
|
IPSW(8) = 1
|
||
|
|
ENDIF
|
||
|
|
!
|
||
|
|
IFIRST = 0
|
||
|
|
RETURN
|
||
|
|
!
|
||
|
|
ELSE
|
||
|
|
! XDIF = TXSCAL * 10.5
|
||
|
|
XDIF = TXSCAL * HSIZE*1.05
|
||
|
|
IXDIF = IFIX( LOG10(XDIF) )
|
||
|
|
XRANGE = 10**IXDIF
|
||
|
|
XFAC = XDIF/XRANGE
|
||
|
|
DX = XRANGE/10.
|
||
|
|
IF ( XFAC .GE. 5.) THEN
|
||
|
|
DX = 5.*DX
|
||
|
|
ELSEIF (XFAC .GE. 2.) THEN
|
||
|
|
DX = 2.*DX
|
||
|
|
ENDIF
|
||
|
|
!
|
||
|
|
X0 = -NINT(XS/DX - .5) * DX - DX
|
||
|
|
X9 = X0 + XDIF
|
||
|
|
!
|
||
|
|
DY = DX
|
||
|
|
!ipk sep94 update to 7.5 scale YDIF = .70*XDIF
|
||
|
|
YDIF = .75*XDIF
|
||
|
|
Y0 = -NINT(YS/DY -.5) * DY - DY
|
||
|
|
Y9 = Y0 + YDIF
|
||
|
|
|
||
|
|
ENDIF
|
||
|
|
!
|
||
|
|
! vertical-grid lines
|
||
|
|
LTP = 0
|
||
|
|
MLEN = 2
|
||
|
|
HT = .18
|
||
|
|
!
|
||
|
|
DO 10 CX = X0,X9, DX
|
||
|
|
XG(1) = (CX + XS)/TXSCAL
|
||
|
|
YG(1) = (Y0 + YS)/TXSCAL
|
||
|
|
XG(2) = XG(1)
|
||
|
|
YG(2) = (Y9 + YS)/TXSCAL
|
||
|
|
CALL NWPEN(8)
|
||
|
|
CALL DASHLN(XG,YG,MLEN,LTP)
|
||
|
|
!
|
||
|
|
FPN = CX
|
||
|
|
IF (AMOD(FPN,1.) .EQ. 0. .OR. ABS(FPN) .LT. 0.01) THEN
|
||
|
|
IPLC = -1
|
||
|
|
ELSE
|
||
|
|
IPLC = 1
|
||
|
|
ENDIF
|
||
|
|
X = XG(1)
|
||
|
|
! Y = YG(1) + .02
|
||
|
|
!ipk oct98 change y location
|
||
|
|
Y = .20
|
||
|
|
IF ( (X .GT. 0. .AND. X .LT. HSIZE) .AND. &
|
||
|
|
& (Y .GT. 0. .AND. Y .LT. 7.5) ) THEN
|
||
|
|
!ipk sep94 change colour CALL NWPEN(12)
|
||
|
|
CALL NWPEN(8)
|
||
|
|
! ipk mar01
|
||
|
|
CALL NUMBR(X,Y,0.15,FPN,0.0,IPLC)
|
||
|
|
ENDIF
|
||
|
|
10 END DO
|
||
|
|
!
|
||
|
|
! horizontal-grid lines
|
||
|
|
DO 20 CY = Y0,Y9, DY
|
||
|
|
XG(1) = (X0 + XS)/TXSCAL
|
||
|
|
YG(1) = (CY + YS)/TXSCAL
|
||
|
|
XG(2) = (X9 + XS)/TXSCAL
|
||
|
|
YG(2) = YG(1)
|
||
|
|
CALL NWPEN(8)
|
||
|
|
CALL DASHLN(XG,YG,MLEN,LTP)
|
||
|
|
!
|
||
|
|
FPN = CY
|
||
|
|
IF (AMOD(FPN,1.) .EQ. 0. .OR. ABS(FPN) .LT. 0.01) THEN
|
||
|
|
IPLC = -1
|
||
|
|
ELSE
|
||
|
|
IPLC = 1
|
||
|
|
ENDIF
|
||
|
|
! X = XG(1)
|
||
|
|
X = .02
|
||
|
|
Y = YG(1)
|
||
|
|
IF ( (X .GT. 0. .AND. X .LT. HSIZE) .AND. &
|
||
|
|
& (Y .GT. 0. .AND. Y .LT. 7.5) ) THEN
|
||
|
|
!ipk sep94 change color CALL NWPEN(12)
|
||
|
|
CALL NWPEN(8)
|
||
|
|
! ipk mar01
|
||
|
|
CALL NUMBR(X,Y,0.15,FPN,0.0,IPLC)
|
||
|
|
ENDIF
|
||
|
|
20 END DO
|
||
|
|
!
|
||
|
|
CALL RBlue
|
||
|
|
!
|
||
|
|
END
|
||
|
|
|
||
|
|
SUBROUTINE RESCAL
|
||
|
|
!
|
||
|
|
! Scale for plotting
|
||
|
|
!
|
||
|
|
!
|
||
|
|
USE BLKMAP
|
||
|
|
USE BLK1MOD
|
||
|
|
! INCLUDE 'BLK1.COM'
|
||
|
|
|
||
|
|
INCLUDE 'TXFRM.COM'
|
||
|
|
|
||
|
|
INCLUDE 'BFILES.I90'
|
||
|
|
!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
|
||
|
|
!
|
||
|
|
VDX = - 1.0E+10
|
||
|
|
XREF=0.
|
||
|
|
YREF=0.
|
||
|
|
!
|
||
|
|
! Reset map coordinates to original scale
|
||
|
|
!
|
||
|
|
IF(MAXPTS .GT. 0) THEN
|
||
|
|
DO J=1,MAXPTS
|
||
|
|
IF(CMAP(J,1) .GE. VDX) THEN
|
||
|
|
CMAP(J,1)=TXSCAL*CMAP(J,1) - XS
|
||
|
|
CMAP(J,2)=TXSCAL*CMAP(J,2) - YS
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
ENDIF
|
||
|
|
!
|
||
|
|
! Reset nodal coordinates
|
||
|
|
!
|
||
|
|
IF(NP .GT. 0) THEN
|
||
|
|
DO J=1,NP
|
||
|
|
CORD(J,1) = XUSR(J)
|
||
|
|
CORD(J,2) = YUSR(J)
|
||
|
|
ENDDO
|
||
|
|
ENDIF
|
||
|
|
!ycw mar97 add for cross section
|
||
|
|
if(ICRS.ne.0) then
|
||
|
|
do i=1,2
|
||
|
|
XPCS(i)=XPCS(i)*TXSCAL - XS
|
||
|
|
YPCS(i)=YPCS(i)*TXSCAL - YS
|
||
|
|
enddo
|
||
|
|
do i=1,NCSNOD
|
||
|
|
XCND(i)=XCND(i)*TXSCAL - XS
|
||
|
|
YCND(i)=YCND(i)*TXSCAL - YS
|
||
|
|
enddo
|
||
|
|
endif
|
||
|
|
!ycw
|
||
|
|
!
|
||
|
|
! Reset controlling scales
|
||
|
|
!
|
||
|
|
TXSCAL = 1.
|
||
|
|
XS=0.
|
||
|
|
YS=0.
|
||
|
|
XMIN = 1.E+20
|
||
|
|
XMAX = -XMIN
|
||
|
|
YMIN = 1.E+20
|
||
|
|
YMAX = -YMIN
|
||
|
|
IF(IMP .GT. 0) THEN
|
||
|
|
!
|
||
|
|
! Find max and min
|
||
|
|
!
|
||
|
|
!
|
||
|
|
DO J=1,MAXPTS
|
||
|
|
IF (CMAP(J,1) .GT. VDX) THEN
|
||
|
|
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)
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
ENDIF
|
||
|
|
!
|
||
|
|
IF(NP .GT. 0) THEN
|
||
|
|
DO J=1,NP
|
||
|
|
IF (CORD(J,1) .GT. VDX) THEN
|
||
|
|
INSKP(J)=0
|
||
|
|
IF (CORD(J,1) .LT. XMIN) XMIN = CORD(J,1)
|
||
|
|
IF (CORD(J,1) .GT. XMAX) XMAX = CORD(J,1)
|
||
|
|
IF (CORD(J,2) .LT. YMIN) YMIN = CORD(J,2)
|
||
|
|
IF (CORD(J,2) .GT. YMAX) YMAX = CORD(J,2)
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
ENDIF
|
||
|
|
IF(NE .GT. 0) THEN
|
||
|
|
DO J=1,NE
|
||
|
|
IF(NOP(J,1) .NE. 0) THEN
|
||
|
|
IESKP(J)=0
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
ENDIF
|
||
|
|
!
|
||
|
|
!
|
||
|
|
DO J=1,NBKFL
|
||
|
|
XMAX=MAX(XMAX,BFMINMAX(J,1),BFMINMAX(J,3))
|
||
|
|
XMIN=MIN(XMIN,BFMINMAX(J,1),BFMINMAX(J,3))
|
||
|
|
YMAX=MAX(YMAX,BFMINMAX(J,2),BFMINMAX(J,4))
|
||
|
|
YMIN=MIN(YMIN,BFMINMAX(J,2),BFMINMAX(J,4))
|
||
|
|
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
|
||
|
|
!
|
||
|
|
! Plot all data
|
||
|
|
!
|
||
|
|
CALL PLOTSV(0)
|
||
|
|
!ipk nov97 add (0)
|
||
|
|
CALL PLOTOT(0)
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
!IPK JAN01 NEW ROUTINE
|
||
|
|
|
||
|
|
SUBROUTINE PLOTCC
|
||
|
|
|
||
|
|
USE BLK1MOD
|
||
|
|
use blk2mod
|
||
|
|
! INCLUDE 'BLK1.COM'
|
||
|
|
DIMENSION XLIN(350),YLIN(350)
|
||
|
|
|
||
|
|
IF(NCLM .GT. 0) THEN
|
||
|
|
|
||
|
|
!Process each line
|
||
|
|
CALL RBLUE
|
||
|
|
|
||
|
|
DO NCLL=1,NCLM
|
||
|
|
WRITE(90,*) 'PLOTR1-1130 NCLL,NCLM',NCLL,NCLM
|
||
|
|
DO KK=1,350
|
||
|
|
IF(ICCLN(NCLL,KK) .NE. 0) THEN
|
||
|
|
IF(KK .EQ. 1) THEN
|
||
|
|
X=CORD(ICCLN(NCLL,KK),1)+0.1
|
||
|
|
Y=CORD(ICCLN(NCLL,KK),2)+0.1
|
||
|
|
IF(X .GT. 0. .AND. X .LT. HSIZE) THEN
|
||
|
|
IF(Y .GT. 0. .AND. Y .LT. 7.5) THEN
|
||
|
|
FPN=NCLL
|
||
|
|
! ipk mar01
|
||
|
|
CALL NUMBR(X,Y,0.2,FPN,0.0,-1)
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
XLIN(KK)=CORD(ICCLN(NCLL,KK),1)
|
||
|
|
YLIN(KK)=CORD(ICCLN(NCLL,KK),2)
|
||
|
|
ELSE
|
||
|
|
if(kk .eq. 1) GO TO 510
|
||
|
|
NTRAC=KK-1
|
||
|
|
X=CORD(ICCLN(NCLL,KK-1),1)+0.1
|
||
|
|
Y=CORD(ICCLN(NCLL,KK-1),2)+0.1
|
||
|
|
IF(X .GT. 0. .AND. X .LT. HSIZE) THEN
|
||
|
|
IF(Y .GT. 0. .AND. Y .LT. 7.5) THEN
|
||
|
|
FPN=NCLL
|
||
|
|
! ipk mar01
|
||
|
|
CALL NUMBR(X,Y,0.2,FPN,0.0,-1)
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
if(ntrac .eq. 1) then
|
||
|
|
call IGrCharSize(0.5,0.5)
|
||
|
|
call IGrMarker(x-0.1,y-0.1,14)
|
||
|
|
call IGrCharSize(1.0,1.0)
|
||
|
|
endif
|
||
|
|
!
|
||
|
|
! Draw along line
|
||
|
|
!
|
||
|
|
IF(NTRAC .GT. 1) THEN
|
||
|
|
CALL THICKL
|
||
|
|
CALL DASHLN(XLIN,YLIN,NTRAC,0)
|
||
|
|
CALL THINL
|
||
|
|
ENDIF
|
||
|
|
GO TO 400
|
||
|
|
ENDIF
|
||
|
|
359 CONTINUE
|
||
|
|
ENDDO
|
||
|
|
400 CONTINUE
|
||
|
|
IF(NTRAC .EQ. 1) THEN
|
||
|
|
NODL=ICCLN(NCLL,1)
|
||
|
|
DO N=1,NE
|
||
|
|
IF(IMAT(N) .LT. 900 .AND. IMAT(N) .GT. 0) THEN
|
||
|
|
IF(NCORN(N) .EQ. 5 .OR. NCORN(N) .EQ. 3) THEN
|
||
|
|
IF(NOP(N,1) .EQ. NODL) THEN
|
||
|
|
DIRX=CORD(NOP(N,3),1)-CORD(NOP(N,1),1)
|
||
|
|
DIRY=CORD(NOP(N,3),2)-CORD(NOP(N,1),2)
|
||
|
|
GO TO 420
|
||
|
|
ELSEIF(NOP(N,3) .EQ. NODL) THEN
|
||
|
|
DIRX=CORD(NOP(N,1),1)-CORD(NOP(N,3),1)
|
||
|
|
DIRY=CORD(NOP(N,1),2)-CORD(NOP(N,3),2)
|
||
|
|
GO TO 420
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
420 DIR=ATAN2(DIRX,-DIRY)
|
||
|
|
D1=CORD(NODL,1)
|
||
|
|
D2=CORD(NODL,2)
|
||
|
|
ELSE
|
||
|
|
|
||
|
|
! Plot arrows on continuity line
|
||
|
|
|
||
|
|
DIRX=CORD(ICCLN(NCLL,1),1)-CORD(ICCLN(NCLL,NTRAC),1)
|
||
|
|
DIRY=CORD(ICCLN(NCLL,1),2)-CORD(ICCLN(NCLL,NTRAC),2)
|
||
|
|
IF(DIRX .EQ. 0. .AND. DIRY .EQ. 0.) THEN
|
||
|
|
DIR=0.
|
||
|
|
ELSE
|
||
|
|
DIR=ATAN2(DIRX,-DIRY)
|
||
|
|
D1=(CORD(ICCLN(NCLL,1),1)+CORD(ICCLN(NCLL,NTRAC),1))/2.
|
||
|
|
D2=(CORD(ICCLN(NCLL,1),2)+CORD(ICCLN(NCLL,NTRAC),2))/2.
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
DIR1=DIR+2.35619
|
||
|
|
DIR2=DIR-2.35619
|
||
|
|
DE1=D1+0.4*COS(DIR)
|
||
|
|
DE2=D2+0.4*SIN(DIR)
|
||
|
|
DEA1=DE1+0.1*COS(DIR1)
|
||
|
|
DEA2=DE2+0.1*SIN(DIR1)
|
||
|
|
DEB1=DE1+0.1*COS(DIR2)
|
||
|
|
DEB2=DE2+0.1*SIN(DIR2)
|
||
|
|
CALL RBLUE
|
||
|
|
CALL PLOTT(D1,D2,3)
|
||
|
|
CALL PLOTT(DE1,DE2,2)
|
||
|
|
CALL PLOTT(DEA1,DEA2,2)
|
||
|
|
CALL PLOTT(DE1,DE2,3)
|
||
|
|
CALL PLOTT(DEB1,DEB2,2)
|
||
|
|
CALL RBLUE
|
||
|
|
510 CONTINUE
|
||
|
|
ENDDO
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
SUBROUTINE PLOTCSTR
|
||
|
|
|
||
|
|
USE BLK1MOD
|
||
|
|
! INCLUDE 'BLK1.COM'
|
||
|
|
|
||
|
|
! Plot arrows on control structures
|
||
|
|
|
||
|
|
DO N=1,NE
|
||
|
|
IF(IMAT(N) .GT. 903) THEN
|
||
|
|
|
||
|
|
DIRX=CORD(NOP(N,3),1)-CORD(NOP(N,1),1)
|
||
|
|
DIRY=CORD(NOP(N,3),2)-CORD(NOP(N,1),2)
|
||
|
|
IF(DIRX .EQ. 0. .AND. DIRY .EQ. 0.) THEN
|
||
|
|
DIR=0.
|
||
|
|
ELSEIF(NCORN(N) .LT. 6) THEN
|
||
|
|
DIR=ATAN2(DIRY,DIRX)
|
||
|
|
D1=CORD(NOP(N,1),1)
|
||
|
|
D2=CORD(NOP(N,1),2)
|
||
|
|
ELSE
|
||
|
|
DIR=ATAN2(DIRX,-DIRY)
|
||
|
|
IF(NOP(N,2) .NE. 0) THEN
|
||
|
|
D1=CORD(NOP(N,2),1)
|
||
|
|
D2=CORD(NOP(N,2),2)
|
||
|
|
ELSE
|
||
|
|
D1=(CORD(NOP(N,1),1)+CORD(NOP(N,3),1))/2.
|
||
|
|
D2=(CORD(NOP(N,1),2)+CORD(NOP(N,3),2))/2.
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
DIR1=DIR+2.35619
|
||
|
|
DIR2=DIR-2.35619
|
||
|
|
IF(IESKP(N) .EQ. 0) THEN
|
||
|
|
IF(NOP(N,2) .NE. 0) THEN
|
||
|
|
D1=CORD(NOP(N,2),1)
|
||
|
|
D2=CORD(NOP(N,2),2)
|
||
|
|
ELSE
|
||
|
|
D1=(CORD(NOP(N,1),1)+CORD(NOP(N,3),1))/2.
|
||
|
|
D2=(CORD(NOP(N,1),2)+CORD(NOP(N,3),2))/2.
|
||
|
|
ENDIF
|
||
|
|
DE1=D1+0.4*COS(DIR)
|
||
|
|
DE2=D2+0.4*SIN(DIR)
|
||
|
|
DEA1=DE1+0.1*COS(DIR1)
|
||
|
|
DEA2=DE2+0.1*SIN(DIR1)
|
||
|
|
DEB1=DE1+0.1*COS(DIR2)
|
||
|
|
DEB2=DE2+0.1*SIN(DIR2)
|
||
|
|
CALL RRED
|
||
|
|
CALL PLOTT(D1,D2,3)
|
||
|
|
CALL PLOTT(DE1,DE2,2)
|
||
|
|
CALL PLOTT(DEA1,DEA2,2)
|
||
|
|
CALL PLOTT(DE1,DE2,3)
|
||
|
|
CALL PLOTT(DEB1,DEB2,2)
|
||
|
|
CALL RBLUE
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
SUBROUTINE PLOTCRSS(isw)
|
||
|
|
|
||
|
|
USE BLK1MOD
|
||
|
|
! INCLUDE 'BLK1.COM'
|
||
|
|
INCLUDE 'TXFRM.COM'
|
||
|
|
! COMMON/ICN1/ ICN(MAXP)
|
||
|
|
|
||
|
|
CHARACTER*11 PART1,PART2
|
||
|
|
|
||
|
|
if(isw .eq. 0) then
|
||
|
|
CALL RGREEN
|
||
|
|
|
||
|
|
DO NN=1,NCRSEC
|
||
|
|
N=IVMIL(NN)
|
||
|
|
IF(N .EQ. 0) CYCLE
|
||
|
|
xpt=(xcrs(n)+xs)/txscal
|
||
|
|
ypt=(ycrs(n)+ys)/txscal
|
||
|
|
a=NOREACH(N)/1000.
|
||
|
|
fpn=n+a
|
||
|
|
IF(XPT .GT. 0. .AND. XPT .LT. HSIZE) THEN
|
||
|
|
IF(YPT .GT. 0. .AND. YPT .LT. 7.5) THEN
|
||
|
|
call plotcr(xpt,ypt,0.05)
|
||
|
|
CALL NUMBR(xpt,ypt-0.1,0.13,FPN,0.0,3)
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
IF(ISW .EQ. 1) THEN
|
||
|
|
|
||
|
|
DO J=1,MAXP
|
||
|
|
ICN(J)=0
|
||
|
|
END DO
|
||
|
|
! First sort out the potential midsides
|
||
|
|
! Note that transition elements caues a problem
|
||
|
|
! Find these first
|
||
|
|
DO 200 N=1,NE
|
||
|
|
if(NCORN(N) .GT. 5) GO TO 200
|
||
|
|
IF(NCORN(N) .EQ. 5 .AND. IMAT(N) .LT. 901) THEN
|
||
|
|
!
|
||
|
|
! We have a transition mark node number as if it were corner
|
||
|
|
!
|
||
|
|
ICN(NOP(N,3))=1
|
||
|
|
ICN(NOP(N,1))=2
|
||
|
|
ICN(NOP(N,4))=2
|
||
|
|
ICN(NOP(N,5))=2
|
||
|
|
ELSE
|
||
|
|
!
|
||
|
|
! Store ICN = 2 for corner nodes
|
||
|
|
!
|
||
|
|
NCN=NCORN(N)
|
||
|
|
!IPKOCT93 IF(IMAT(N) .GT. 900) THEN
|
||
|
|
IF(IMAT(N) .GT. 900 .AND. IMAT(N) .LT. 904) THEN
|
||
|
|
MST=1
|
||
|
|
ELSE
|
||
|
|
MST=2
|
||
|
|
ENDIF
|
||
|
|
DO 180 M=1,NCN,MST
|
||
|
|
ICN(NOP(N,M))=2
|
||
|
|
180 CONTINUE
|
||
|
|
ENDIF
|
||
|
|
200 END DO
|
||
|
|
|
||
|
|
DO J=1,NP
|
||
|
|
|
||
|
|
IF(ICN(J) .EQ. 2) THEN
|
||
|
|
WRITE(PART1,'(I5,F6.3)') &
|
||
|
|
,NRIVCR1(J),WTRIVCR1(J)
|
||
|
|
|
||
|
|
WRITE(PART2,'(I5,F6.3)') &
|
||
|
|
,NRIVCR2(J),WTRIVCR2(J)
|
||
|
|
|
||
|
|
IF (CORD(J,1) .LT. VDX) GO TO 300
|
||
|
|
X = CORD(J,1)
|
||
|
|
Y = CORD(J,2)
|
||
|
|
|
||
|
|
CALL RBlack
|
||
|
|
IF(X .GT. 0. .AND. X .LT. HSIZE) THEN
|
||
|
|
IF(Y .GT. 0. .AND. Y .LT. 7.5) THEN
|
||
|
|
CALL SYMBL(X-0.25,Y+.24,0.10,PART1,0.0,11)
|
||
|
|
CALL SYMBL(X-0.25,Y+.12,0.10,PART2,0.0,11)
|
||
|
|
endif
|
||
|
|
ENDIF
|
||
|
|
300 CONTINUE
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
ENDIF
|
||
|
|
CALL RBlue
|
||
|
|
RETURN
|
||
|
|
END
|