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.
463 lines
14 KiB
Fortran
463 lines
14 KiB
Fortran
!IPK LAST UPDATE JULY 7 2016 ADD TEST FOR ZERO WIDTH
|
|
SUBROUTINE CHKAREA
|
|
|
|
USE WINTERACTER
|
|
USE BLK1MOD
|
|
include 'd.inc'
|
|
! INCLUDE 'BLK1.COM'
|
|
|
|
COMMON /OPTION/ SWITCH(4),NUMV,CONTUR(99),IQUAL,XCSQ,NUMCOL
|
|
|
|
dimension itran(0:16)
|
|
data itran/0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16/
|
|
|
|
DATA I1,I2,I3,I4/1,0,0,0/,EMAX/-1./
|
|
|
|
WRITE(90,*) 'GOING TO CHKOPT'
|
|
CALL GETCHOPT(I1,I2,I3,I4,EREF,WIDEL)
|
|
WRITE(90,*) I1
|
|
IF(I1 .LT. 0) THEN
|
|
I1=1
|
|
I2=0
|
|
RETURN
|
|
ENDIF
|
|
IF(I1 .EQ. 1) THEN
|
|
! and see if all corner nodes exist
|
|
!
|
|
! Test for areas of each element
|
|
!
|
|
INEG = 0
|
|
!IPK JUL16
|
|
IERW=0
|
|
DO 250 N=1,NE
|
|
IF(IMAT(N) .GT. 0 .AND. NCORN(N) .GT. 5) THEN
|
|
J1=NOP(N,1)
|
|
J2=NOP(N,3)
|
|
J3=NOP(N,5)
|
|
if(cord(j1,1) .lt. -1.e9 .or. cord(j2,1) .lt. -1.e9 .or. cord(j3,1) .lt. -1.e9) then
|
|
WRITE(90,*) ' NODE UNDEFINED FOR ELEMENT NUMBER',N
|
|
CALL DELTEL(N)
|
|
CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Element removed','ELEMENT REMOVED')
|
|
GO TO 250
|
|
ENDIF
|
|
AREA=(CORD(J2,1)-CORD(J1,1))*(CORD(J3,2)-CORD(J1,2))- &
|
|
& (CORD(J3,1)-CORD(J1,1))*(CORD(J2,2)-CORD(J1,2))
|
|
IF(AREA .LT. 0.) THEN
|
|
WRITE(90,*) ' NEGATIVE AREA FOR ELEMENT NUMBER',N
|
|
INEG = 1
|
|
GO TO 250
|
|
ENDIF
|
|
IF(NCORN(N) .EQ. 8) THEN
|
|
J1=NOP(N,3)
|
|
J2=NOP(N,5)
|
|
J3=NOP(N,7)
|
|
if(cord(j1,1) .lt. -1.e9 .or. cord(j2,1) .lt. -1.e9 .or. cord(j3,1) .lt. -1.e9) then
|
|
WRITE(90,*) ' NODE UNDEFINED FOR ELEMENT NUMBER',N
|
|
CALL DELTEL(N)
|
|
CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Element removed','ELEMENT REMOVED')
|
|
GO TO 250
|
|
ENDIF
|
|
AREA=(CORD(J2,1)-CORD(J1,1))*(CORD(J3,2)-CORD(J1,2))- &
|
|
& (CORD(J3,1)-CORD(J1,1))*(CORD(J2,2)-CORD(J1,2))
|
|
IF(AREA .LT. 0.) THEN
|
|
WRITE(90,*) ' NEGATIVE AREA FOR ELEMENT NUMBER',N
|
|
INEG = 1
|
|
ENDIF
|
|
ENDIF
|
|
!IPK JUL16 ADD TEST FOR MISSING WIDTH
|
|
ELSEIF(IMAT(N) .GT. 0) THEN
|
|
IF(WIDTH(NOP(N,1)) .EQ. 0. .OR. WIDTH(NOP(N,3)) .EQ. 0) THEN
|
|
IF(IERW .EQ. 0) THEN
|
|
CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Nodal width missing in 1-D element'//Char(13)//&
|
|
'See file MESSGEN.OUT for details' ,'WARNING 1-D WIDTH MISSING')
|
|
write(90,6000)
|
|
write(90,6001) n,nop(n,1),width(nop(n,1)),nop(n,3),width(nop(n,3))
|
|
6000 FORMAT(' NODAL WIDTH MISSING FOR 1-D ELEMENT'/' ELEMENT NODE1 WIDTH1 NODE2 WIDTH2')
|
|
6001 FORMAT(I8,2(I10,F10.2))
|
|
IERW=1
|
|
ELSE
|
|
write(90,6001) n,nop(n,1),width(nop(n,1)),nop(n,3),width(nop(n,3))
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
250 END DO
|
|
|
|
IF(INEG .EQ. 1) THEN
|
|
!cipk aug00
|
|
|
|
Call WMessageBox(3,2,1,'Negative Areas have been found'//Char(13)//&
|
|
'See file MESSGEN.OUT for details'//'Press YES to set positive',&
|
|
'ERROR IN NETWORK AREAS!!')
|
|
|
|
IF(WinfoDialog(ExitButtonCommon) .eq. CommonOK) then
|
|
!
|
|
! Test for areas of each element
|
|
!
|
|
INEG=0
|
|
DO 300 N=1,NE
|
|
IF(IMAT(N) .GT. 0 .AND. NCORN(N) .GT. 5) THEN
|
|
J1=NOP(N,1)
|
|
J2=NOP(N,3)
|
|
J3=NOP(N,5)
|
|
AREA=(CORD(J2,1)-CORD(J1,1))*(CORD(J3,2)-CORD(J1,2))- &
|
|
& (CORD(J3,1)-CORD(J1,1))*(CORD(J2,2)-CORD(J1,2))
|
|
IF(AREA .LT. 0.) THEN
|
|
if(NCORN(N) .EQ. 6) THEN
|
|
JM12=NOP(N,2)
|
|
JM23=NOP(N,4)
|
|
JM31=NOP(N,6)
|
|
NOP(N,2)=JM31
|
|
NOP(N,3)=J3
|
|
NOP(N,4)=JM23
|
|
NOP(N,5)=J2
|
|
NOP(N,6)=JM12
|
|
GO TO 300
|
|
ELSEIF(NCORN(N) .EQ. 8) THEN
|
|
INEG=1
|
|
ENDIF
|
|
ENDIF
|
|
IF(NCORN(N) .EQ. 8) THEN
|
|
J1=NOP(N,3)
|
|
J2=NOP(N,5)
|
|
J3=NOP(N,7)
|
|
AREA=(CORD(J2,1)-CORD(J1,1))*(CORD(J3,2)-CORD(J1,2))- &
|
|
& (CORD(J3,1)-CORD(J1,1))*(CORD(J2,2)-CORD(J1,2))
|
|
IF(AREA .LT. 0.) THEN
|
|
IF(INEG .EQ. 1) THEN
|
|
J0=NOP(N,1)
|
|
JM01=NOP(N,2)
|
|
JM12=NOP(N,4)
|
|
JM23=NOP(N,6)
|
|
JM30=NOP(N,8)
|
|
NOP(N,2)=JM30
|
|
NOP(N,3)=J3
|
|
NOP(N,4)=JM23
|
|
NOP(N,5)=J2
|
|
NOP(N,6)=JM12
|
|
NOP(N,7)=J1
|
|
NOP(N,8)=JM01
|
|
ELSE
|
|
WRITE(90,*) ' CROSS OVER NEGATIVE AREA FOR ELEMENT NUMBER',N
|
|
Call WMessageBox(3,2,1,'cross-over element diagonals have been found'//Char(13)//&
|
|
'See file MESSGEN.OUT for details'//'Press YES to set delete',&
|
|
'ERROR IN NETWORK AREAS!!')
|
|
IF(WinfoDialog(ExitButtonCommon) .eq. CommonOK) then
|
|
CALL DELTEL(N)
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
300 END DO
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
! CARRY OUT TEST FOR ELEMENT ELEVATION DIFFERENCES
|
|
IF(I2 .EQ. 1) THEN
|
|
EMAX=0.
|
|
DO N=1,NE
|
|
EDIF(N)=0
|
|
IF(IMAT(N) .LE. 0) GO TO 400
|
|
IF(NCORN(N) .GT. 5) THEN
|
|
DO M=1,NCORN(N)-1,2
|
|
DO MM=M,NCORN(N)-1,2
|
|
EDIF(N)=MAX(ABS(WD(NOP(N,M))-WD(NOP(N,MM))),EDIF(N))
|
|
ENDDO
|
|
ENDDO
|
|
ELSE
|
|
IF(I4 .EQ. 0) THEN
|
|
EDIF(N)=ABS(WD(NOP(N,3))-WD(NOP(N,1)))
|
|
ELSE
|
|
if(icrin .eq. 0) then
|
|
CALL WMessageBox(0, 4, 1,'Cross-section data not loaded '//CHAR(13)// &
|
|
'Click OK start again','ERROR GETTING NO SECTION DATA')
|
|
RETURN
|
|
endif
|
|
N1=NOP(N,1)
|
|
N2=NOP(N,3)
|
|
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
|
|
IF(H1 .LT. 0. .OR. H2 .LT. 0.) THEN
|
|
CALL WMessageBox(1, 4, 1,'Depth negative '//CHAR(13)// &
|
|
'Click OK to continue with depth=1.'//CHAR(13)//'Click Cancel to start again','ERROR GETTING SECTION DATA')
|
|
if(WInfoDialog(4) .eq. 0) then
|
|
RETURN
|
|
else
|
|
IF(H1 .LT. 0.) H1=1.0
|
|
IF(H2 .LT. 0.) H2=1.0
|
|
endif
|
|
ENDIF
|
|
CALL INTERPWLV(N1,H1,AR1,WR1,DWR1)
|
|
CALL INTERPWLV(N2,H2,AR2,WR2,DWR2)
|
|
IF(I4 .EQ. 1) THEN
|
|
EDIF(N)=ABS(WR1-WR2)
|
|
ELSE
|
|
EDIF(N)=ABS(AR1-AR2)
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
IF(EDIF(N) .GT. EMAX) EMAX=EDIF(N)
|
|
400 CONTINUE
|
|
ENDDO
|
|
NUMV=13
|
|
CONTUR(1)=-0.5
|
|
DO K=2,13
|
|
CONTUR(K)=(EMAX+0.5)/12.+CONTUR(K-1)
|
|
ENDDO
|
|
|
|
DO N=1,NE
|
|
! IF(N .EQ. 46451) WRITE(155,*) N,EMAX,EDIF(N)
|
|
IF(IMAT(N) .GT. 0) THEN
|
|
IF(EDIF(N) .LT. 0.001) THEN
|
|
ICOL=1
|
|
ELSE
|
|
ICOL=EDIF(N)*12./EMAX+.999
|
|
ENDIF
|
|
icll=itran(icol)
|
|
! IF(N .EQ. 46451) WRITE(155,*) N,ICOL,EMAX,EDIF(N)
|
|
CALL FILLEMC(N,ICLL)
|
|
ENDIF
|
|
ENDDO
|
|
XLEG=8.8
|
|
YLEG=7.4
|
|
|
|
CALL LEGND(XLEG,YLEG,CONTUR,NUMV,NUMCOL)
|
|
|
|
ENDIF
|
|
EDIF(0)=EMAX
|
|
CALL WMenuSetState(ID_SECGRP,ItemEnabled,1)
|
|
IF(I2 .EQ. 1) RETURN
|
|
! CARRY OUT TEST FOR ELEMENT NORMAILZED DEPTH DIFFERENCES
|
|
IF(I3 .EQ. 1) THEN
|
|
EMAX=0.
|
|
DO N=1,NE
|
|
EDIF(N)=0
|
|
IF(IMAT(N) .LE. 0) GO TO 500
|
|
IF(NCORN(N) .GT. 5) THEN
|
|
DO M=1,NCORN(N)-1,2
|
|
DO MM=M,NCORN(N)-1,2
|
|
D1=EREF-WD(NOP(N,M))
|
|
D2=EREF-WD(NOP(N,MM))
|
|
if(d1 .lt. 0.0) d1=0.0
|
|
if(d2 .lt. 0.0) d2=0.0
|
|
DMEAN=(D1+D2)/2.
|
|
if(DMEAN .LE. 1.) DMEAN=1.0
|
|
EDIF(N)=MAX(ABS(D1-D2)/DMEAN,EDIF(N))
|
|
ENDDO
|
|
ENDDO
|
|
ELSE
|
|
IF(I4 .EQ. 0) THEN
|
|
D1=EREF-WD(NOP(N,1))
|
|
D2=EREF-WD(NOP(N,3))
|
|
IF(D1 .LT. 0. .OR. D2 .LT. 0.) THEN
|
|
CALL WMessageBox(1, 4, 1,'Depth negative '//CHAR(13)// &
|
|
'Click OK to continue with depth=1.'//CHAR(13)//'Click Cancel to start again','ERROR GETTING SECTION DATA')
|
|
if(WInfoDialog(4) .eq. 0) then
|
|
RETURN
|
|
else
|
|
IF(D1 .LT. 0.) D1=1.0
|
|
IF(D2 .LT. 0.) D2=1.0
|
|
endif
|
|
ENDIF
|
|
|
|
DMEAN=(D1+D2)/2.
|
|
if(DMEAN .LE. 1.) DMEAN=1.0
|
|
EDIF(N)=ABS(D1-D2)/DMEAN
|
|
ELSE
|
|
if(icrin .eq. 0) then
|
|
CALL WMessageBox(0, 4, 1,'Cross-section data not loaded '//CHAR(13)// &
|
|
'Click OK start again','ERROR GETTING NO SECTION DATA')
|
|
RETURN
|
|
endif
|
|
N1=NOP(N,1)
|
|
N2=NOP(N,3)
|
|
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
|
|
IF(H1 .LT. 0. .OR. H2 .LT. 0.) THEN
|
|
CALL WMessageBox(1, 4, 1,'Depth negative '//CHAR(13)// &
|
|
'Click OK to continue with depth=1.'//CHAR(13)//'Click Cancel to start again','ERROR GETTING SECTION DATA')
|
|
if(WInfoDialog(4) .eq. 0) then
|
|
RETURN
|
|
else
|
|
IF(H1 .LT. 0.) H1=1.0
|
|
IF(H2 .LT. 0.) H2=1.0
|
|
endif
|
|
ENDIF
|
|
CALL INTERPWLV(N1,H1,AR1,WR1,DWR1)
|
|
CALL INTERPWLV(N2,H2,AR2,WR2,DWR2)
|
|
IF(I4 .EQ. 1) THEN
|
|
EDIF(N)=ABS(WR1-WR2)*2./(WR1+WR2)
|
|
ELSE
|
|
EDIF(N)=ABS(AR1-AR2)*2./(AR1+AR2)
|
|
ENDIF
|
|
ENDIF
|
|
|
|
ENDIF
|
|
IF(EDIF(N) .GT. EMAX) EMAX=EDIF(N)
|
|
500 CONTINUE
|
|
ENDDO
|
|
NUMV=11
|
|
CONTUR(1)=0.
|
|
DO K=2,11
|
|
CONTUR(K)=EMAX/10.+CONTUR(K-1)
|
|
ENDDO
|
|
|
|
DO N=1,NE
|
|
IF(IMAT(N) .GT. 0) THEN
|
|
ICOL=EDIF(N)*10./EMAX+.999
|
|
icll=itran(icol)
|
|
CALL FILLEMC(N,ICLL)
|
|
ENDIF
|
|
ENDDO
|
|
XLEG=8.8
|
|
YLEG=7.4
|
|
|
|
CALL LEGND(XLEG,YLEG,CONTUR,NUMV,NUMCOL)
|
|
|
|
ENDIF
|
|
EDIF(0)=EMAX
|
|
CALL WMenuSetState(ID_SECGRP,ItemEnabled,1)
|
|
FLUSH(90)
|
|
IF(I3 .EQ. 1) RETURN
|
|
|
|
CALL PLOTOT(0)
|
|
CALL HEDR
|
|
RETURN
|
|
END
|
|
|
|
|
|
SUBROUTINE GETCHOPT(I1,I2,I3,I4,EREF,WIDEL)
|
|
!
|
|
! Generate continuity lines
|
|
!
|
|
|
|
USE WINTERACTER
|
|
include 'd.inc'
|
|
SAVE
|
|
|
|
!
|
|
! Declare window-type and message variables
|
|
!
|
|
TYPE(WIN_STYLE) :: WINDOW
|
|
|
|
TYPE(WIN_MESSAGE) :: MESSAGE
|
|
|
|
integer :: I1,I2,I3,I4,I4A,ITIME,IPOS
|
|
|
|
REAL :: WIDEL
|
|
|
|
REAL :: EREF
|
|
|
|
data itime/0/
|
|
|
|
IF(ITIME .EQ. 0) THEN
|
|
EREF=0.
|
|
WIDEL=0.
|
|
itime=1.
|
|
I4=0
|
|
ENDIF
|
|
|
|
call wdialogload(IDD_CHKOPT)
|
|
ierr=infoerror(1)
|
|
|
|
CALL WDialogSelect(IDD_CHKOPT)
|
|
ierr=infoerror(1)
|
|
|
|
I4A=I4
|
|
IF(I4 .GT. 0) I4A=1
|
|
call wdialogputCheckBox(idf_check1,I1)
|
|
call wdialogputCheckBox(idf_check2,I4A)
|
|
if(i2 .eq. 1) then
|
|
CALL WDialogPutRadioButton(IDF_RADIO1)
|
|
elseif(i3 .eq. 1) then
|
|
CALL WDialogPutRadioButton(IDF_RADIO2)
|
|
endif
|
|
CALL WDialogPutReal(IDF_REAL1,EREF)
|
|
|
|
CALL WDialogShow(-1,-1,0,Modal)
|
|
ierr=infoerror(1)
|
|
|
|
do
|
|
!
|
|
IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
|
|
|
|
call wdialogGetCheckBox(idf_check1,I1)
|
|
call wdialogGetCheckBox(idf_check2,I4A)
|
|
call wdialogGetRadioButton(idf_radio1,IPOS)
|
|
IF(IPOS .EQ. 1) THEN
|
|
I2=1
|
|
I3=0
|
|
ELSEIF(IPOS .EQ. 2) THEN
|
|
I2=0
|
|
I3=1
|
|
ELSE
|
|
I2=0
|
|
I3=0
|
|
ENDIF
|
|
CALL WDialoggetReal(IDF_REAL1,EREF)
|
|
GO TO 100
|
|
|
|
ELSEIF(WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
|
|
I1=-1
|
|
I2=0
|
|
I3=0
|
|
WRITE(90,*) 'CANCEL',I1,I2,I3,I4A
|
|
return
|
|
ENDIF
|
|
|
|
enddo
|
|
100 CONTINUE
|
|
WRITE(90,*) 'IN CHKOPT',I1,I2,I3,I4A
|
|
|
|
IF(I4A .NE. 0) THEN
|
|
call wdialogload(IDD_CHK1DOPT)
|
|
ierr=infoerror(1)
|
|
|
|
CALL WDialogSelect(IDD_CHK1DOPT)
|
|
ierr=infoerror(1)
|
|
|
|
if(i4 .le. 1) then
|
|
CALL WDialogPutRadioButton(IDF_RADIO1)
|
|
elseif(i4 .eq. 2) then
|
|
CALL WDialogPutRadioButton(IDF_RADIO2)
|
|
endif
|
|
CALL WDialogPutReal(IDF_REAL1,WIDEL)
|
|
|
|
CALL WDialogShow(-1,-1,0,Modal)
|
|
|
|
do
|
|
!
|
|
IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
|
|
|
|
call wdialogGetRadioButton(idf_radio1,I4)
|
|
CALL WDialogGetReal(IDF_REAL1,WIDEL)
|
|
|
|
WRITE(90,*) 'OUT OF CHKOPT',I1,I2,I3,I4A
|
|
return
|
|
|
|
ELSEIF(WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
|
|
|
|
I4=0
|
|
I4A=0
|
|
|
|
ENDIF
|
|
|
|
enddo
|
|
|
|
ENDIF
|
|
WRITE(90,*) 'OUT OF CHKOPT',I1,I2,I3,I4A
|
|
return
|
|
end
|
|
|