SUBROUTINE COMPWGT USE BLK1MOD ! INCLUDE 'BLK1.COM' ! COMMON/ICN1/ ICN(MAXP) DIST(X1,X2,Y1,Y2)=SQRT((X1-X2)**2+(Y1-Y2)**2) 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))=IMAT(N) ICN(NOP(N,4))=IMAT(N) ICN(NOP(N,5))=IMAT(N) 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 GO TO 185 ELSE MST=2 ENDIF DO 180 M=1,NCN,MST ICN(NOP(N,M))=IMAT(N) 180 CONTINUE 185 CONTINUE ENDIF 200 END DO DO N=1,NP IF(ICN(N) .GT. 0) THEN ADIST=1.E20 DO J=1,NCRSEC IF(IVMIL(J) .EQ. 0) CYCLE IF(ICN(N) .EQ. NOREACH(IVMIL(J))) THEN A1=DIST(XUSR(N),XCRS(IVMIL(J)),YUSR(N),YCRS(IVMIL(J))) IF(A1 .LT. ADIST) THEN ADIST=A1 NSEC1=IVMIL(J) ENDIF ENDIF ENDDO !IPK JUN04 IF(ADIST .EQ. 1.E20) THEN NRIVCR1(N)=0 NRIVCR2(N)=0 WTRIVCR1(N)=0 WTRIVCR2(N)=0 ELSE BDIST=1.E20 DO J=1,NCRSEC IF(IVMIL(J) .EQ. 0) CYCLE IF(ICN(N) .EQ. NOREACH(IVMIL(J))) THEN IF(IVMIL(J) .NE. NSEC1) THEN A1=DIST(XUSR(N),XCRS(IVMIL(J)),YUSR(N),YCRS(IVMIL(J))) A2=DIST(XCRS(NSEC1),XCRS(IVMIL(J)),YCRS(NSEC1),YCRS(IVMIL(J))) ! A1 IS DISTANCE TO NODE ! A2 IS DISTANCE TO RECORDED POINT IF(A2 .GE. A1) THEN IF(A1 .LT. BDIST) THEN BDIST=A1 NSEC2=IVMIL(J) ENDIF ENDIF ENDIF ENDIF ENDDO IF(BDIST .EQ. 1.E20) NSEC2=NSEC1 NRIVCR1(N)=NSEC1 NRIVCR2(N)=NSEC2 WTRIVCR1(N)=BDIST/(ADIST+BDIST) WTRIVCR2(N)=ADIST/(ADIST+BDIST) ENDIF ENDIF ENDDO RETURN END SUBROUTINE GETCSLOC use winteracter USE BLK1MOD ! INCLUDE 'BLK1.COM' INCLUDE 'TXFRM.COM' !- include 'd.inc' ! ! Declare window-type and message variables ! TYPE(WIN_STYLE) :: WINDOW TYPE(WIN_MESSAGE) :: MESSAGE INTEGER :: IERR,ISET,IBOX REAL :: ASET CHARACTER*1 :: IFLAG call wdialogload(IDD_CSLOC) ierr=infoerror(1) CALL WDialogSelect(IDD_CSLOC) ierr=infoerror(1) ISET=1 100 continue CALL WDialogPutINTEGER(IDF_INTEGER1,ISET) CALL WDialogShow(-1,-1,0,Modal) ierr=infoerror(1) DO ! IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN CALL WDialogGetINTEGER(IDF_INTEGER1,ISET) GO TO 200 else RETURN endif ENDDO 200 CONTINUE CALL XYLOC(XX,YY,IFLAG,IBOX) IF(IRMAIN .EQ. 1) RETURN XCRS(ISET) = XX*TXSCAL - XS YCRS(ISET) = YY*TXSCAL - YS GO TO 100 RETURN END