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.
307 lines
7.6 KiB
Fortran
307 lines
7.6 KiB
Fortran
5 years ago
|
SUBROUTINE dograph(noptt,icurrwin)
|
||
|
|
!!!!!! (XVALUES,YVALUES,NVALUES,XMIN,XMAX,VALMIN,YMAX)
|
||
|
|
!
|
||
|
|
! Graph plotting code generated by GraphEd at 21:20 on 11 Apr 1999.
|
||
|
|
!
|
||
|
|
! XVALUES = Array of X values to plot
|
||
|
|
! YVALUES = Array of Y values to plot
|
||
|
|
! NVALUES = Number of values
|
||
|
|
! TIMMIN = Min X
|
||
|
|
! TIMMAX = Max X
|
||
|
|
! VALMIN = Min Y
|
||
|
|
! VALMAX = Max Y
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! USE module containing routine definitions and symbolic names.
|
||
|
|
!
|
||
|
|
USE WINTERACTER
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Common arguments.
|
||
|
|
!
|
||
|
|
CHARACTER*6 DESCR
|
||
|
|
CHARACTER*48 XLABEL, YYLABEL
|
||
|
|
CHARACTER*48 PTITL
|
||
|
|
CHARACTER*4 AXTYPE, YAXTYPE
|
||
|
|
COMMON /XYGRPH/ XVALUES(10000,10),YVALUES(10000,10),TIMMIN,VALMIN,TIMMAX,VALMAX,NVALUES,NSETS,LINPROP(10)
|
||
|
|
COMMON /PAXC/ PTITL,AXTYPE,XLABEL,YAXTYPE,YYLABEL
|
||
|
|
|
||
|
|
COMMON /HEDS1/ NWINDWS,IWNDWS(10),ISCRNS(10),DESCR(10)
|
||
|
|
|
||
|
|
|
||
|
|
COMMON /HEDS/ NP,NE,NHTP,NMESS,NBRR,IPSW(15),IRMAIN,ISCRN,icolon(12),IQSW(2),IRDISP,ntempin,igfgsw,igfgswb,ICRIN,IPW1,WIDEL,WIDSCL,itrianout
|
||
|
|
CHARACTER*80 TITLE
|
||
|
|
CHARACTER*24 HLABL
|
||
|
|
character*40 mpnam
|
||
|
|
CHARACTER*1 ALABL(10)
|
||
|
|
COMMON /BLKA1/ TITLE,HLABL,ALABL,MPNAM
|
||
|
|
|
||
|
|
character*8 labl
|
||
|
|
character*72 data
|
||
|
|
CHARACTER*20 TITL1,TITL4
|
||
|
|
CHARACTER*64 TITL2,TITL3
|
||
|
|
COMMON /BLKA11/ TITL1,TITL2,TITL3,TITL4&
|
||
|
|
, labl(400),data(400)
|
||
|
|
|
||
|
|
!IPK JAN03
|
||
|
|
|
||
|
|
INTEGER IHANDLE1
|
||
|
|
|
||
|
|
! REAL, INTENT(IN), DIMENSION(NVALUES) :: XVALUES
|
||
|
|
! REAL, INTENT(IN), DIMENSION(NVALUES) :: YVALUES
|
||
|
|
! REAL TIMMIN,TIMMAX,VALMIN,VALMAX
|
||
|
|
! INTEGER NVALUES
|
||
|
|
|
||
|
|
|
||
|
|
nopt=abs(noptt)
|
||
|
|
WRITE(90,*) 'IN DOGRAPH',NOPT,icurrwin
|
||
|
|
|
||
|
|
! nopt = 999 skip to draw current page
|
||
|
|
! nopt = -2 skip to draw current page
|
||
|
|
! nopt = 2 draw time plots
|
||
|
|
! nopt = 4 from brkarea
|
||
|
|
|
||
|
|
if(nopt .eq. 999) go to 300
|
||
|
|
IF(NOPTT .EQ. -2) GO TO 300
|
||
|
|
if(nopt .ne. 3) then
|
||
|
|
|
||
|
|
! do this only for nopt = 4 or nopt = 2 first search for empty window
|
||
|
|
|
||
|
|
do n=1,nwindws
|
||
|
|
if(iwndws(n) .eq. 0) then
|
||
|
|
icurrwin=n
|
||
|
|
go to 290
|
||
|
|
endif
|
||
|
|
enddo
|
||
|
|
|
||
|
|
! or increase window count
|
||
|
|
|
||
|
|
|
||
|
|
nwindws=nwindws+1
|
||
|
|
if(nwindws .eq. 10) then
|
||
|
|
call WMessageBox(0,3,1,'Warning 10 windows now open','WARNING')
|
||
|
|
IF(WInfoDialog(4) .eq. 1) then
|
||
|
|
ENDIF
|
||
|
|
endif
|
||
|
|
icurrwin=nwindws
|
||
|
|
290 continue
|
||
|
|
else
|
||
|
|
|
||
|
|
! do this for nopt = 3 ie
|
||
|
|
! draw the bitmap in icurrwin and return
|
||
|
|
|
||
|
|
call backp(2,icurrwin)
|
||
|
|
return
|
||
|
|
endif
|
||
|
|
!ipk jan03
|
||
|
|
|
||
|
|
! if no window defined yet open a child window for it and give it a handle
|
||
|
|
|
||
|
|
IF(Iwndws(icurrwin) .EQ. 0) THEN
|
||
|
|
CALL WindowOpenChild(IHANDLE1,FLAGS=SysMenuOn+MinButton+MaxButton, &
|
||
|
|
TITLE='Cross-Section')
|
||
|
|
Iwndws(icurrwin)=ihandle1
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
! setup to draw bitmap in icurrwin
|
||
|
|
|
||
|
|
CALL BACKP(1,icurrwin)
|
||
|
|
300 continue
|
||
|
|
!
|
||
|
|
! Start new presentation graphics plot
|
||
|
|
!
|
||
|
|
! CALL IPgNewGraph(NSETS,NVALUES,' ',' ','X')
|
||
|
|
CALL IPgNewPlot(6,nsets,nvalues)
|
||
|
|
!
|
||
|
|
! Set Clipping Rectangle
|
||
|
|
!
|
||
|
|
CALL IPgClipRectangle('G')
|
||
|
|
!
|
||
|
|
! Set style for each data set
|
||
|
|
!
|
||
|
|
! CALL IPgStyle( 1, 0, 0, 0,223, 96)
|
||
|
|
! CALL IPgStyle( 2, 1, 0, 0, 31,128)
|
||
|
|
! CALL IPgStyle( 3, 2, 0, 0,159,160)
|
||
|
|
! CALL IPgStyle( 4, 3, 0, 0, 95,192)
|
||
|
|
! CALL IPgStyle( 5, 5, 0, 0,223,224)
|
||
|
|
|
||
|
|
ICL=255+256*255+256*256*255
|
||
|
|
IF(LINPROP(1) .EQ. 0) THEN
|
||
|
|
CALL IPgStyle( 1, 0, 0, 0,223,195)
|
||
|
|
ELSE
|
||
|
|
CALL IPgStyle( 1, 0, 3, 0,ICL,195)
|
||
|
|
ENDIF
|
||
|
|
IF(LINPROP(2) .EQ. 0) THEN
|
||
|
|
CALL IPgStyle( 2, 1, 0, 0,33405,33405)
|
||
|
|
ELSE
|
||
|
|
CALL IPgStyle( 2, 1, 3, 0,ICL,33405)
|
||
|
|
ENDIF
|
||
|
|
IF(LINPROP(3) .EQ. 0) THEN
|
||
|
|
CALL IPgStyle( 3, 2, 0, 0,8551680,8551680)
|
||
|
|
ELSE
|
||
|
|
CALL IPgStyle( 3, 2, 3, 0,ICL,8551680)
|
||
|
|
ENDIF
|
||
|
|
IF(LINPROP(4) .EQ. 0) THEN
|
||
|
|
CALL IPgStyle( 4, 3, 0, 0,65415,65415)
|
||
|
|
ELSE
|
||
|
|
CALL IPgStyle( 4, 3, 3, 0,ICL,65415)
|
||
|
|
ENDIF
|
||
|
|
IF(LINPROP(5) .EQ. 0) THEN
|
||
|
|
CALL IPgStyle( 5, 5, 0, 0,0,0)
|
||
|
|
ELSE
|
||
|
|
CALL IPgStyle( 5, 5, 3, 0,ICL,0)
|
||
|
|
ENDIF
|
||
|
|
!
|
||
|
|
! Set marker number for data sets not using default marker
|
||
|
|
!
|
||
|
|
CALL IPgMarker( 1, 1)
|
||
|
|
CALL IPgMarker( 2, 2)
|
||
|
|
CALL IPgMarker( 3, 2)
|
||
|
|
CALL IPgMarker( 4, 2)
|
||
|
|
CALL IPgMarker( 5, 2)
|
||
|
|
!
|
||
|
|
! Set units for plot
|
||
|
|
!
|
||
|
|
CALL IPgUnits( TIMMIN, VALMIN, TIMMAX, VALMAX)
|
||
|
|
!
|
||
|
|
! Set presentation graphics area
|
||
|
|
!
|
||
|
|
CALL IPgArea( .150, .100, .900, .800)
|
||
|
|
!
|
||
|
|
! Draw main title
|
||
|
|
!
|
||
|
|
CALL IGrCharSet('H')
|
||
|
|
CALL IGrCharFont( 1)
|
||
|
|
CALL IGrCharSpacing('F')
|
||
|
|
CALL IGrCharSize( 0.67, 0.67)
|
||
|
|
CALL IGrColourN( 208)
|
||
|
|
|
||
|
|
CALL IPgTitle('CROSS-SECTION','C')
|
||
|
|
!
|
||
|
|
! Label bottom X axis
|
||
|
|
!
|
||
|
|
CALL IPgXLabelPos( .70)
|
||
|
|
CALL IPgXLabel('Section Dimension','C')
|
||
|
|
|
||
|
|
!
|
||
|
|
! Label left Y axis
|
||
|
|
!
|
||
|
|
CALL IPgYLabelPos( .80)
|
||
|
|
|
||
|
|
CALL IPgYLabelLeft('Elevation','C9')
|
||
|
|
!
|
||
|
|
! Draw axes
|
||
|
|
!
|
||
|
|
CALL IGrColourN( 208)
|
||
|
|
CALL IPgAxes(TIMMIN,VALMIN)
|
||
|
|
!
|
||
|
|
! Adjust tick position for X Axes
|
||
|
|
!
|
||
|
|
CALL IPgXTickPos(VALMIN,VALMAX)
|
||
|
|
!DEC09 CALL IPgXTickPos(1,TIMMIN)
|
||
|
|
!
|
||
|
|
! Scale for bottom X Axis
|
||
|
|
!
|
||
|
|
CALL IPgXUserScale((/0.0/),0)
|
||
|
|
CALL IPgXScaleAngle( .00, .00)
|
||
|
|
CALL IPgXScalePos( .38)
|
||
|
|
CALL IPgXScale('NT')
|
||
|
|
!
|
||
|
|
! Adjust tick position for Y Axes
|
||
|
|
!
|
||
|
|
CALL IPgYTickPos( TIMMIN , TIMMAX )
|
||
|
|
!DEC09 CALL IPgYTickPos( 1,VALMIN)
|
||
|
|
!DEC09 ISIDE=1
|
||
|
|
!DEC09 CALL IPgYTickPos( ISIDE,TIMMAX)
|
||
|
|
! Scale for left Y Axis
|
||
|
|
!
|
||
|
|
CALL IPgYUserScale((/0.0/),0)
|
||
|
|
CALL IPgYScaleAngle( .00, .00)
|
||
|
|
CALL IPgYScalePos( 1.50)
|
||
|
|
CALL IPgYScaleLeft('NT')
|
||
|
|
!
|
||
|
|
! Draw graph.
|
||
|
|
!
|
||
|
|
DO ISET = 1,NSETS
|
||
|
|
|
||
|
|
CALL IPgXYPairs(XVALUES(1,iset),YVALUES(1,ISET))
|
||
|
|
|
||
|
|
END DO
|
||
|
|
|
||
|
|
call IPgKeyAll(DESCR,' ')
|
||
|
|
|
||
|
|
! CALL SYMBL(0.1,7.60,0.18,TITL2,0.0,+64)
|
||
|
|
|
||
|
|
|
||
|
|
if(nopt .ne. 999 .and. NOPTT .NE. -2) CALL BACKP(2,icurrwin)
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
END SUBROUTINE dograph
|
||
|
|
|
||
|
|
|
||
|
|
SUBROUTINE BACKP(IENT,icurrwin)
|
||
|
|
|
||
|
|
! ient = 1 means either set to draw bitmap or create window for plotting ihandle(icurrwin)
|
||
|
|
! then select to draw bitmap
|
||
|
|
! ient = 2 means select drawing of window and putting the bitmap into it, folloed by return
|
||
|
|
! to main window
|
||
|
|
! ient = 3 means destroy slected window
|
||
|
|
|
||
|
|
|
||
|
|
use winteracter
|
||
|
|
|
||
|
|
implicit none
|
||
|
|
|
||
|
|
include 'D.INC'
|
||
|
|
|
||
|
|
!
|
||
|
|
! Declare window-type and message variables
|
||
|
|
!
|
||
|
|
TYPE(WIN_STYLE) :: WINDOW
|
||
|
|
|
||
|
|
TYPE(WIN_MESSAGE) :: MESSAGE
|
||
|
|
INTEGER :: iw,ih,ihandle,ient,icurrwin,ihandlem
|
||
|
|
common /handP/ ihandle(10)
|
||
|
|
! write(128,*) 'ient',ient,icurrwin,ihandle(icurrwin)
|
||
|
|
if(ient .eq. 1) then
|
||
|
|
iw=WinfoWindow(WindowWidth)
|
||
|
|
ih=WinfoWindow(WindowHeight)
|
||
|
|
IF(IHANDLE(icurrwin) .EQ. 0) THEN
|
||
|
|
call WBitmapCreate(ihandle(icurrwin),iw,ih)
|
||
|
|
call IGrSelect(DrawBitmap,ihandle(icurrwin))
|
||
|
|
ELSE
|
||
|
|
call IGrSelect(DrawBitmap,ihandle(icurrwin))
|
||
|
|
ENDIF
|
||
|
|
return
|
||
|
|
elseif(ient .eq. 2) then
|
||
|
|
call IGrSelect(DrawWin)
|
||
|
|
call WBitmapPut(ihandle(icurrwin),0,1)
|
||
|
|
!!! call WBitmapDestroy(ihandle)
|
||
|
|
ihandlem=0
|
||
|
|
call WindowSelect(ihandlem)
|
||
|
|
else
|
||
|
|
CALL WBitmapDestroy(ihandle(icurrwin))
|
||
|
|
|
||
|
|
endif
|
||
|
|
return
|
||
|
|
end
|
||
|
|
|
||
|
|
SUBROUTINE DOPLOT(IMZ)
|
||
|
|
|
||
|
|
|
||
|
|
COMMON /HEDS1/ NWINDWS,IWNDWS(10),ISCRNS(10)
|
||
|
|
|
||
|
|
if(nwindws .gt. 0) then
|
||
|
|
do n=1,nwindws
|
||
|
|
if(iscrns(n) .eq. 3) then
|
||
|
|
call WindowSelect(iwndws(n))
|
||
|
|
call clscrn
|
||
|
|
call dograph(3,n)
|
||
|
|
endif
|
||
|
|
enddo
|
||
|
|
call WindowSelect(0)
|
||
|
|
endif
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
END
|