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.
158 lines
4.0 KiB
Fortran
158 lines
4.0 KiB
Fortran
5 years ago
|
!-----------------------------------------------------------------crsect
|
||
|
|
subroutine crsect
|
||
|
|
!----------------------------------------------------------------------c
|
||
|
|
! purpose: c
|
||
|
|
! To plot a selected cross section and calculate width and c
|
||
|
|
! slopes. c
|
||
|
|
! ycw mar97 c
|
||
|
|
!----------------------------------------------------------------------c
|
||
|
|
USE BLKMAP
|
||
|
|
USE BLK1MOD
|
||
|
|
USE BLK2MOD
|
||
|
|
! include 'BLK1.COM'
|
||
|
|
! include 'BLK2.COM'
|
||
|
|
|
||
|
|
real XPL(5),YPL(5),ss0(50)
|
||
|
|
CHARACTER*1 ANS,ANSW(0:4),IFLAG
|
||
|
|
CHARACTER*6 DESCR
|
||
|
|
|
||
|
|
INCLUDE 'TXFRM.COM'
|
||
|
|
|
||
|
|
COMMON /XYGRPH/ XVALUES(10000,10),YVALUES(10000,10),TIMMIN,VALMIN,TIMMAX,VALMAX,NVALUES,NSETS,LINPROP(10)
|
||
|
|
|
||
|
|
COMMON /HEDS1/ NWINDWS,IWNDWS(10),ISCRNS(10),DESCR(10),ICRSR(10)
|
||
|
|
DATA MAN/1/
|
||
|
|
|
||
|
|
!
|
||
|
|
!------get cross section number
|
||
|
|
!
|
||
|
|
! 100 NHTP=0
|
||
|
|
! NMESS=29
|
||
|
|
! NBRR=6
|
||
|
|
call selcrs(man)
|
||
|
|
|
||
|
|
if(man .eq. 2) then
|
||
|
|
call setlim(timmin,timmax,valmin,valmax)
|
||
|
|
else
|
||
|
|
|
||
|
|
!
|
||
|
|
!......establish shape of curve
|
||
|
|
!
|
||
|
|
|
||
|
|
timmin=1.e20
|
||
|
|
valmin=1.e20
|
||
|
|
timmax=-1.e20
|
||
|
|
valmax=-1.e20
|
||
|
|
endif
|
||
|
|
|
||
|
|
DO J=1,5
|
||
|
|
icr=icrsr(j)
|
||
|
|
if(icr .gt. 0) then
|
||
|
|
do i=nrivl(icr),1,-1
|
||
|
|
|
||
|
|
ii=nrivl(icr)-i+1
|
||
|
|
xvalues(ii,j)=-crsdat(icr,i,3)/2.
|
||
|
|
yvalues(ii,j)=crsdat(icr,i,1)
|
||
|
|
ij=nrivl(icr)+i
|
||
|
|
xvalues(ij,j)=crsdat(icr,i,3)/2.
|
||
|
|
yvalues(ij,j)=crsdat(icr,i,1)
|
||
|
|
|
||
|
|
enddo
|
||
|
|
nsets=j
|
||
|
|
|
||
|
|
if(man .eq. 1) then
|
||
|
|
timmin=min(timmin,-crsdat(icr,nrivl(icr),3)/2.)
|
||
|
|
valmin=min(valmin,crsdat(icr,1,1))
|
||
|
|
timmax=max(timmax,crsdat(icr,nrivl(icr),3)/2.)
|
||
|
|
valmax=max(valmax,crsdat(icr,nrivl(icr),1))
|
||
|
|
endif
|
||
|
|
|
||
|
|
NVALUES=2*nrivl(icr)
|
||
|
|
write(DESCR(j),'(i6)') ICR
|
||
|
|
endif
|
||
|
|
enddo
|
||
|
|
call dograph(2,icurwin)
|
||
|
|
iscrns(icurwin)=3
|
||
|
|
|
||
|
|
return
|
||
|
|
END
|
||
|
|
|
||
|
|
subroutine selcrs(MAN)
|
||
|
|
|
||
|
|
USE WINTERACTER
|
||
|
|
INCLUDE 'D.INC'
|
||
|
|
CHARACTER*6 DESCR
|
||
|
|
|
||
|
|
COMMON /HEDS1/ NWINDWS,IWNDWS(10),ISCRNS(10),DESCR(10),ICRSR(10)
|
||
|
|
|
||
|
|
call wdialogload(IDD_SELCRSEC)
|
||
|
|
ierr=infoerror(1)
|
||
|
|
|
||
|
|
CALL WDialogSelect(IDD_SECCRSEC)
|
||
|
|
ierr=infoerror(1)
|
||
|
|
|
||
|
|
do i=1,5
|
||
|
|
CALL WGridPutCellInteger(IDF_GRID1,i,1,icrsr(i))
|
||
|
|
enddo
|
||
|
|
|
||
|
|
if(man .eq. 1) then
|
||
|
|
CALL WDialogPutRadioButton(IDF_RADIO1)
|
||
|
|
else
|
||
|
|
CALL WDialogPutRadioButton(IDF_RADIO2)
|
||
|
|
endif
|
||
|
|
|
||
|
|
CALL WDialogShow(-1,-1,0,Modal)
|
||
|
|
ierr=infoerror(1)
|
||
|
|
|
||
|
|
do
|
||
|
|
IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
|
||
|
|
do i=1,5
|
||
|
|
CALL WGridGetCellInteger(IDF_GRID1,i,1,icrsr(i))
|
||
|
|
enddo
|
||
|
|
CALL WDialogGetRadioButton(IDF_RADIO1,man)
|
||
|
|
return
|
||
|
|
else
|
||
|
|
return
|
||
|
|
endif
|
||
|
|
|
||
|
|
enddo
|
||
|
|
return
|
||
|
|
|
||
|
|
end
|
||
|
|
|
||
|
|
subroutine setlim(timmin,timmax,valmin,valmax)
|
||
|
|
|
||
|
|
USE WINTERACTER
|
||
|
|
INCLUDE 'D.INC'
|
||
|
|
CHARACTER*6 DESCR
|
||
|
|
|
||
|
|
call wdialogload(IDD_LIMITS)
|
||
|
|
ierr=infoerror(1)
|
||
|
|
|
||
|
|
CALL WDialogSelect(IDD_LIMITS)
|
||
|
|
ierr=infoerror(1)
|
||
|
|
|
||
|
|
|
||
|
|
CALL WDialogPutReal(IDF_REAL1,TIMMIN)
|
||
|
|
CALL WDialogPutReal(IDF_REAL2,TIMMAX)
|
||
|
|
CALL WDialogPutReal(IDF_REAL3,VALMIN)
|
||
|
|
CALL WDialogPutReal(IDF_REAL4,VALMAX)
|
||
|
|
|
||
|
|
CALL WDialogShow(-1,-1,0,Modal)
|
||
|
|
ierr=infoerror(1)
|
||
|
|
|
||
|
|
do
|
||
|
|
IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
|
||
|
|
CALL WDialogGetReal(IDF_REAL1,TIMMIN)
|
||
|
|
CALL WDialogGetReal(IDF_REAL2,TIMMAX)
|
||
|
|
CALL WDialogGetReal(IDF_REAL3,VALMIN)
|
||
|
|
CALL WDialogGetReal(IDF_REAL4,VALMAX)
|
||
|
|
return
|
||
|
|
else
|
||
|
|
return
|
||
|
|
endif
|
||
|
|
|
||
|
|
enddo
|
||
|
|
return
|
||
|
|
|
||
|
|
end
|