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.
237 lines
7.5 KiB
Fortran
237 lines
7.5 KiB
Fortran
5 years ago
|
SUBROUTINE SHOWEQ(ISWT)
|
||
|
|
use winteracter
|
||
|
|
USE BLKELTLD
|
||
|
|
save
|
||
|
|
include 'D.inc'
|
||
|
|
INCLUDE 'TXFRM.COM'
|
||
|
|
!
|
||
|
|
! Declare window-type and message variables
|
||
|
|
!
|
||
|
|
TYPE(WIN_STYLE) :: WINDOW
|
||
|
|
|
||
|
|
TYPE(WIN_MESSAGE) :: MESSAGE
|
||
|
|
|
||
|
|
COMMON /OPTION/ SWITCH(4),NUMV,CONTUR(99),IQUAL,XCSQ,NUMCOL
|
||
|
|
REAL HMAX(200),HRSTART,HREND
|
||
|
|
INTEGER IYSTART, IYEND, IDYSTART,IDYEND,ick1
|
||
|
|
data ick1/0/,ITIME/0/
|
||
|
|
IF(ISWT .EQ. 1) GO TO 140
|
||
|
|
IF(ITIME .EQ. 0) THEN
|
||
|
|
IYSTART=IYDATE(1)
|
||
|
|
IYEND=IYDATE(1)
|
||
|
|
IDYSTART=TAE(1,1)/24.
|
||
|
|
HRSTART=TAE(1,1)-IDYSTART*24
|
||
|
|
IDYSTART=IDYSTART+1
|
||
|
|
IDYEND=IDYSTART
|
||
|
|
HREND=HRSTART
|
||
|
|
ITIME=1
|
||
|
|
ENDIF
|
||
|
|
call wdialogload(IDD_SETUPELDISP)
|
||
|
|
ierr=infoerror(1)
|
||
|
|
|
||
|
|
CALL WDialogSelect(IDD_IDD_SETUPELDISP)
|
||
|
|
ierr=infoerror(1)
|
||
|
|
call wdialogputRadioButton(idf_radio1)
|
||
|
|
call wdialogputCheckBox(idf_check1,ick1)
|
||
|
|
CALL WDialogPutInteger(idf_integer1,IYSTART)
|
||
|
|
CALL WDialogPutInteger(idf_integer2,IDYSTART)
|
||
|
|
CALL WDialogPutInteger(idf_integer3,IYEND)
|
||
|
|
CALL WDialogPutInteger(idf_integer5,IDYEND)
|
||
|
|
CALL WDialogPutReal(idf_real1,HRSTART)
|
||
|
|
CALL WDialogPutReal(idf_real3,HREND)
|
||
|
|
|
||
|
|
CALL WDialogShow(-1,-1,0,Modal)
|
||
|
|
ierr=infoerror(1)
|
||
|
|
|
||
|
|
do
|
||
|
|
!
|
||
|
|
IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
|
||
|
|
|
||
|
|
|
||
|
|
call wdialogGetRadioButton(idf_radio1,iopt)
|
||
|
|
call wdialogGetCheckBox(idf_check1,ick1)
|
||
|
|
CALL WDialogGetInteger(idf_integer1,IYSTART)
|
||
|
|
CALL WDialogGetInteger(idf_integer2,IDYSTART)
|
||
|
|
CALL WDialogGetInteger(idf_integer3,IYEND)
|
||
|
|
CALL WDialogGetInteger(idf_integer5,IDYEND)
|
||
|
|
CALL WDialogGetReal(idf_real1,HRSTART)
|
||
|
|
CALL WDialogGetReal(idf_real3,HREND)
|
||
|
|
GO TO 80
|
||
|
|
|
||
|
|
elseif(WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
|
||
|
|
RETURN
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
80 CONTINUE
|
||
|
|
TTMIN=1.E20
|
||
|
|
TTMAX=-1.E20
|
||
|
|
if(ick1 .eq. 0) then
|
||
|
|
DO I=1,NQHYD
|
||
|
|
IF(IRMATYP .EQ. 11) THEN
|
||
|
|
IF(NEST(I) .EQ. 3) CYCLE
|
||
|
|
ENDIF
|
||
|
|
NST=NHYE(I)
|
||
|
|
if(iopt .eq. 1) then
|
||
|
|
HMAX(I)=-1.E20
|
||
|
|
DO K=1,NST
|
||
|
|
HMAX(I)=MAX(HAE(K,I),HMAX(I))
|
||
|
|
ENDDO
|
||
|
|
TTMIN=MIN(HMAX(I),TTMIN)
|
||
|
|
TTMAX=MAX(HMAX(I),TTMAX)
|
||
|
|
else
|
||
|
|
HMAX(I)=0.0
|
||
|
|
DO K=2,NST
|
||
|
|
IF(TAE(K,I)-TAE(K-1,I) .LT. 0.) THEN
|
||
|
|
IF(MOD(IYDATE(I),4) .EQ. 0) THEN
|
||
|
|
TCOR=366*24.
|
||
|
|
ELSE
|
||
|
|
TCOR=365*24.
|
||
|
|
ENDIF
|
||
|
|
ELSE
|
||
|
|
TCOR=0.
|
||
|
|
ENDIF
|
||
|
|
HMAX(I)=HMAX(I)+(HAE(K-1,I)+HAE(K,I))/2.*(TAE(K,I)+TCOR-TAE(K-1,I))*3.600E-3
|
||
|
|
ENDDO
|
||
|
|
TTMIN=MIN(HMAX(I),TTMIN)
|
||
|
|
TTMAX=MAX(HMAX(I),TTMAX)
|
||
|
|
endif
|
||
|
|
ENDDO
|
||
|
|
else
|
||
|
|
DO I=1,NQHYD
|
||
|
|
IF(IRMATYP .EQ. 11) THEN
|
||
|
|
IF(NEST(I) .EQ. 3) CYCLE
|
||
|
|
ENDIF
|
||
|
|
TASTART=(IDYSTART-1)*24.+HRSTART
|
||
|
|
TAEND=(IDYEND-1)*24.+HREND
|
||
|
|
IF(IYSTART-IYDATE(I) .GT. 0) THEN
|
||
|
|
TASTART=TASTART+365*24.*(IYSTART-IYDATE(I))
|
||
|
|
IF(MOD(IYDATE(I),4) .EQ. 0) TASTART=TASTART+24.
|
||
|
|
ENDIF
|
||
|
|
IF(IYEND-IYDATE(I) .GT. 0) THEN
|
||
|
|
TAEND=TAEND+365*24.*(IYEND-IYDATE(I))
|
||
|
|
IF(MOD(IYDATE(I),4) .EQ. 0) TAEND=TAEND+24.
|
||
|
|
ENDIF
|
||
|
|
NST=NHYE(I)
|
||
|
|
if(iopt .eq. 1) then
|
||
|
|
HMAX(I)=-1.E20
|
||
|
|
TCOR=0.
|
||
|
|
DO K=2,NST
|
||
|
|
IF(TAE(K,I)-TAE(K-1,I) .LT. 0.) THEN
|
||
|
|
TCOR=TCOR+365*24.
|
||
|
|
ENDIF
|
||
|
|
TTEMP=TAE(K,I)+TCOR
|
||
|
|
IF(TTEMP .LT. TASTART) CYCLE
|
||
|
|
IF(TTEMP .GT. TAEND) GO TO 120
|
||
|
|
HMAX(I)=MAX(HAE(K,I),HMAX(I))
|
||
|
|
ENDDO
|
||
|
|
120 CONTINUE
|
||
|
|
TTMIN=MIN(HMAX(I),TTMIN)
|
||
|
|
TTMAX=MAX(HMAX(I),TTMAX)
|
||
|
|
else
|
||
|
|
HMAX(I)=0.0
|
||
|
|
TCOR=0.
|
||
|
|
DO K=2,NST
|
||
|
|
IF(TAE(K,I)-TAE(K-1,I) .LT. 0.) THEN
|
||
|
|
IF(MOD(IYDATE(I),4) .EQ. 0) THEN
|
||
|
|
TCOR=TCOR+366*24.
|
||
|
|
ELSE
|
||
|
|
TCOR=TCOR+365*24.
|
||
|
|
ENDIF
|
||
|
|
! TCOR=TCOR+365*24.
|
||
|
|
TDIF=TAE(K,I)-TAE(K-1,I)+TCOR
|
||
|
|
ELSE
|
||
|
|
TDIF=TAE(K,I)-TAE(K-1,I)
|
||
|
|
ENDIF
|
||
|
|
TTEMP=TAE(K,I)+TCOR
|
||
|
|
IF(TTEMP .LT. TASTART) CYCLE
|
||
|
|
IF(TTEMP .GT. TAEND) GO TO 130
|
||
|
|
HMAX(I)=HMAX(I)+(HAE(K-1,I)+HAE(K,I))/2.*TDIF*3.600E-3
|
||
|
|
ENDDO
|
||
|
|
130 CONTINUE
|
||
|
|
TTMIN=MIN(HMAX(I),TTMIN)
|
||
|
|
TTMAX=MAX(HMAX(I),TTMAX)
|
||
|
|
endif
|
||
|
|
ENDDO
|
||
|
|
endif
|
||
|
|
ISZ=1
|
||
|
|
RAD=10.
|
||
|
|
CALL CSET(TTMIN,TTMAX,isz)
|
||
|
|
140 CONTINUE
|
||
|
|
DO I=1,NQHYD
|
||
|
|
IF(IRMATYP .EQ. 11) THEN
|
||
|
|
IF(NEST(I) .EQ. 3) CYCLE
|
||
|
|
ENDIF
|
||
|
|
DO J=1,NUMV
|
||
|
|
IF(HMAX(I) .LE. CONTUR(J)) THEN
|
||
|
|
ncoln=mod(J,13)+4
|
||
|
|
JJ=NCLINE(I)
|
||
|
|
! CALL GETXCL(JJ,XCJ,YCJ)
|
||
|
|
call change_color(ncoln)
|
||
|
|
! CALL FILLEMC(NCLINE(I),NCOLN)
|
||
|
|
|
||
|
|
raddisp=0.05
|
||
|
|
! if(raddisp .lt. 0.01) raddisp=0.01
|
||
|
|
! call circle(xcj,ycj,raddisp)
|
||
|
|
XCT=(XYCEL(I,1)+XS)/TXSCAL
|
||
|
|
YCT=(XYCEL(I,2)+YS)/TXSCAL
|
||
|
|
call circle(xct,yct,raddisp)
|
||
|
|
GO TO 200
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
200 CONTINUE
|
||
|
|
ENDDO
|
||
|
|
CALL RBLACK
|
||
|
|
DO I=1,NQHYD
|
||
|
|
IF(IRMATYP .EQ. 11) THEN
|
||
|
|
IF(NEST(I) .EQ. 3) CYCLE
|
||
|
|
ENDIF
|
||
|
|
JJ=NCLINE(I)
|
||
|
|
! CALL GETXCL(JJ,XCJ,YCJ)
|
||
|
|
! CALL NUMBR(XCJ,YCJ,0.15,HMAX(I),0.0,1)
|
||
|
|
XCT=(XYCEL(I,1)+XS)/TXSCAL
|
||
|
|
YCT=(XYCEL(I,2)+YS)/TXSCAL
|
||
|
|
CALL NUMBR(XCT,YCT,0.15,HMAX(I),0.0,1)
|
||
|
|
enddo
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
END
|
||
|
|
|
||
|
|
SUBROUTINE GETXCL(J,XCJ,YCJ)
|
||
|
|
|
||
|
|
USE BLK1MOD
|
||
|
|
|
||
|
|
XXC=0.
|
||
|
|
YYC=0.
|
||
|
|
IF(IMAT(J) .EQ. 0) GO TO 50
|
||
|
|
NCN = NCORN(J)
|
||
|
|
IF(NCN .EQ. 9) THEN
|
||
|
|
NCNR=8
|
||
|
|
ELSE
|
||
|
|
NCNR=NCN
|
||
|
|
ENDIF
|
||
|
|
NCNT=0
|
||
|
|
DO 25 K=1,NCNR
|
||
|
|
N = NOP(J,K)
|
||
|
|
!
|
||
|
|
IF (N .EQ. 0 .OR. XUSR(N) .LT. VDX) GOTO 25
|
||
|
|
! !
|
||
|
|
IF (NCN .NE. 5 .OR. K .LT. 5) THEN
|
||
|
|
IF (MOD(K,2) .EQ. 1) THEN
|
||
|
|
XXC = XXC + XUSR(N)
|
||
|
|
YYC = YYC + YUSR(N)
|
||
|
|
NCNT=NCNT+1
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
25 CONTINUE
|
||
|
|
|
||
|
|
IF(NCN .LT. 9) THEN
|
||
|
|
XCJ = XXC/NCNT
|
||
|
|
YCJ = YYC/NCNT
|
||
|
|
ELSE
|
||
|
|
XCJ= XUSR(NOP(J,9))
|
||
|
|
YCJ= YUSR(NOP(J,9))
|
||
|
|
ENDIF
|
||
|
|
50 CONTINUE
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|