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.
270 lines
9.7 KiB
Fortran
270 lines
9.7 KiB
Fortran
!IPK LAST UPDATE jAN 25 2001 INCREMENT NP FOR ALREADY EXISTING NODES IN NOP
|
|
!IPK LAST UPDATE APR 6 1998
|
|
SUBROUTINE FILM(ISWT)
|
|
!june93 SUBROUTINE FILM(IFILL)
|
|
!-
|
|
! ISWT = 0 means read a value for IFILL
|
|
! ISWT = 1 means use a value of 1 for IFILL
|
|
! If IFILL = 1, use all unused node nos. for filling midside nodes
|
|
! If IFILL = 0, start midside node numbering with max node no.
|
|
!-
|
|
USE WINTERACTER
|
|
USE BLK1MOD
|
|
USE BLK2MOD
|
|
! INCLUDE 'BLK1.COM'
|
|
! INCLUDE 'BLK2.COM'
|
|
INCLUDE 'BFILES.I90'
|
|
INCLUDE 'TXFRM.COM'
|
|
!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
|
|
|
|
INTEGER NUSED(MAXP)
|
|
|
|
!IPK MAY02
|
|
REAL*8 XX,YY
|
|
data itime/0/
|
|
|
|
if(itime .eq. 0) then
|
|
ifill=0
|
|
itime=1
|
|
endif
|
|
! call WcursorShape(1)
|
|
NHTPsv = nhtp
|
|
NMESSsv = nmess
|
|
NBRRsv = nbrr
|
|
NHTP = 0
|
|
NBRR = 0
|
|
NMESS=45
|
|
CALL HEDR
|
|
NMESS = 19
|
|
xprt=3.2
|
|
!
|
|
IF(ISWT .EQ. 0) THEN
|
|
CALL GETINT(IFILL)
|
|
ELSE
|
|
IFILL=1
|
|
ENDIF
|
|
!
|
|
|
|
!-
|
|
!-.....FIND MISSING NODE NUMBERS.....
|
|
!-
|
|
NP0 = 0
|
|
DO 10 I=1,MAXP
|
|
10 NUSED(I) = 0
|
|
DO 101 J = 1, NE
|
|
IF( IMAT(J) .EQ. 0 ) GO TO 101
|
|
DO 100 K = 1, 8
|
|
IF( NOP(J,K) .LE. 0) GOTO 100
|
|
NUSED(NOP(J,K))=999
|
|
100 END DO
|
|
101 END DO
|
|
|
|
! Form list of elements connected to nodes
|
|
IERR=0
|
|
CALL NDNECON(IERR)
|
|
IF(IERR .GT. 0) THEN
|
|
LIMIT=MAXECON
|
|
CALL NODERR(IERR,LIMIT)
|
|
GO TO 200
|
|
ENDIF
|
|
!C-
|
|
!C-.....PUT INPUTS INTO PROPER LOCATIONS.....
|
|
!C-
|
|
! DO 140 J = 1, NE
|
|
! IF( IMAT(J) .EQ. 0 ) GO TO 140
|
|
! IF( NOP(J,5) .GT. 0 ) GO TO 140
|
|
! DO 130 K = 1, 4
|
|
! IT(K) = NOP(J,K)
|
|
! NOP(J,K) = 0
|
|
! 130 CONTINUE
|
|
! KK = 0
|
|
! DO 135 K = 1, 8, 2
|
|
! KK = KK + 1
|
|
! NOP(J,K) = IT(KK)
|
|
! 135 CONTINUE
|
|
! 140 CONTINUE
|
|
!-
|
|
!-.....INSERT NEW NUMBERS.....
|
|
!-
|
|
NP0=0
|
|
IF(IFILL .EQ. 0) NP0=NP
|
|
DO 190 J = 1, NE
|
|
!ipk apr98 IF( IMAT(J) .GT. 0 .AND. IMAT(J) .LT.901) THEN
|
|
IF(( IMAT(J) .GT. 0 .AND. IMAT(J) .LT.901) .or. &
|
|
& imat(j) .gt. 903) THEN
|
|
NCN = NCORN(J)
|
|
JN = J + 1
|
|
DO 180 K = 2, NCN, 2
|
|
if((imat(j) .gt. 995 .and. imat(j) .lt. 1999) .and. (k .eq. 4 .or. k .eq. 8) &
|
|
& ) go to 180
|
|
NA = K - 1
|
|
NB = MOD(K+1,NCN)
|
|
IF(NB .EQ. 0) NB=NCN
|
|
NA = NOP(J,NA)
|
|
NB = NOP(J,NB)
|
|
AA=(WD(NA)+WD(NB))/2.
|
|
AB=(WD1(NA)+WD1(NB))/2.
|
|
IF( NOP(J,K) .EQ. 0 ) THEN
|
|
IRDONE=0
|
|
99 NP0 = NP0 + 1
|
|
IF(NP0 .GT. MAXP) THEN
|
|
CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Execution terminated, nodal limits exceeded. Backup written','LIMITS EXCEEDED')
|
|
CALL WRTOUT(0)
|
|
STOP
|
|
ENDIF
|
|
IF(INEW(NP0) .EQ. 1) GO TO 99
|
|
IF (NUSED(NP0) .GT. 0) GOTO 99
|
|
NOP(J,K) = NP0
|
|
XX=(CORD(NA,1)+CORD(NB,1))/2.
|
|
YY=(CORD(NA,2)+CORD(NB,2))/2.
|
|
CORD(NP0,1)=XX
|
|
CORD(NP0,2)=YY
|
|
WD(NP0)=AA
|
|
WD1(NP0)=AB
|
|
WIDTH(NP0)=(WIDTH(NA)+WIDTH(NB))/2.
|
|
SS1(NP0)=(SS1(NA)+SS1(NB))/2.
|
|
SS2(NP0)=(SS2(NA)+SS2(NB))/2.
|
|
WIDS(NP0)=(WIDS(NA)+WIDS(NB))/2.
|
|
WIDBS(NP0)=(WIDBS(NA)+WIDBS(NB))/2.
|
|
BS1(NP0)=(BS1(NA)+BS1(NB))/2.
|
|
|
|
|
|
INEW(NP0) = 1
|
|
IF(LOCK(NA) .EQ. 1 .AND. LOCK(NB) .EQ. 1) LOCK(NP0)=1
|
|
XUSR(NP0) = XX*TXSCAL - XS
|
|
|
|
YUSR(NP0) = YY*TXSCAL - YS
|
|
INSKP(NP0) = 0
|
|
!SSO(N),-
|
|
!,BS1(N)-.....SEARCH FOR OTHER ELEMENT.....
|
|
!-
|
|
!ipk dec98 set a counter
|
|
ielct=0
|
|
|
|
!ipk0ct93 DO 170 JJ = JN, NE
|
|
|
|
DO 170 JJJ=1,NDELM(NA)
|
|
JJ=NECON(NA,JJJ)
|
|
!IPK SEP02 DO 170 JJ = 1, NE
|
|
!ipkoct93 IF( IMAT(JJ) .GT. 0 .OR. IMAT(JJ) .LT.901) THE
|
|
if(jj .eq. j) go to 170
|
|
if(imat(jj) .gt. 0) then
|
|
NNCN = NCORN(JJ)
|
|
DO 160 KK = 2, NNCN, 2
|
|
IF( NOP(JJ,KK-1) .EQ. NB ) THEN
|
|
KN = MOD(KK+1,NNCN)
|
|
IF(KN .EQ. 0) KN=NNCN
|
|
IF( NOP(JJ,KN) .EQ. NA ) THEN
|
|
NOP(JJ,KK) = NP0
|
|
!ipk dec98
|
|
ielct=ielct+1
|
|
if(ielct .eq. 2) then
|
|
GO TO 180
|
|
else
|
|
go to 170
|
|
endif
|
|
!ipk dec98 end changes
|
|
ENDIF
|
|
!IPK APR98 ADD
|
|
ELSEIF( NOP(JJ,KK-1) .EQ. NA ) THEN
|
|
KN = MOD(KK+1,NNCN)
|
|
IF(KN .EQ. 0) KN=NNCN
|
|
IF( NOP(JJ,KN) .EQ. NB ) THEN
|
|
NOP(JJ,KK) = NP0
|
|
!ipk dec98
|
|
ielct=ielct+1
|
|
if(ielct .eq. 2) then
|
|
GO TO 180
|
|
else
|
|
go to 170
|
|
endif
|
|
!ipk dec98 end changes
|
|
ENDIF
|
|
!IPK APR98
|
|
ENDIF
|
|
160 CONTINUE
|
|
ENDIF
|
|
170 CONTINUE
|
|
ELSE
|
|
NM=NOP(J,K)
|
|
IF(INEW(NM) .NE. 1) THEN
|
|
XX=(CORD(NA,1)+CORD(NB,1))/2.
|
|
YY=(CORD(NA,2)+CORD(NB,2))/2.
|
|
CORD(NM,1)=XX
|
|
CORD(NM,2)=YY
|
|
WD(NM)=AA
|
|
WD1(NM)=AB
|
|
WIDTH(NM)=(WIDTH(NA)+WIDTH(NB))/2.
|
|
SS1(NM)=(SS1(NA)+SS1(NB))/2.
|
|
SS2(NM)=(SS2(NA)+SS2(NB))/2.
|
|
WIDS(NM)=(WIDS(NA)+WIDS(NB))/2.
|
|
WIDBS(NM)=(WIDBS(NA)+WIDBS(NB))/2.
|
|
BS1(NM)=(BS1(NA)+BS1(NB))/2.
|
|
INEW(NM) = 1
|
|
IF(LOCK(NA) .EQ. 1 .AND. LOCK(NB) .EQ. 1) LOCK(NM)=1
|
|
XUSR(NM) = XX*TXSCAL - XS
|
|
YUSR(NM) = YY*TXSCAL - YS
|
|
INSKP(NM) = 0
|
|
!ipk jan01
|
|
IF(NM .GT. NP) NP=NM
|
|
ELSE
|
|
WD(NM)=AA
|
|
WD1(NM)=AB
|
|
ENDIF
|
|
ENDIF
|
|
180 CONTINUE
|
|
ENDIF
|
|
190 CONTINUE
|
|
IF (NP0 .GT. NP) NP=NP0
|
|
200 CONTINUE
|
|
NHTP = nhtpsv
|
|
NMESS = nmesssv
|
|
NBRR = nbrrsv
|
|
! call WcursorShape(0)
|
|
|
|
!IPK MAY03
|
|
ICHG=0
|
|
|
|
RETURN
|
|
END
|
|
|
|
|
|
SUBROUTINE NODERR(NODER,LIMIT)
|
|
|
|
USE WINTERACTER
|
|
include 'd.inc'
|
|
|
|
!
|
|
! Declare window-type and message variables
|
|
!
|
|
TYPE(WIN_STYLE) :: WINDOW
|
|
|
|
TYPE(WIN_MESSAGE) :: MESSAGE
|
|
|
|
|
|
INTEGER :: IERR,NODER,LIMIT
|
|
|
|
call wdialogload(IDD_NODERR)
|
|
ierr=infoerror(1)
|
|
|
|
CALL WDialogSelect(IDD_NODERR)
|
|
ierr=infoerror(1)
|
|
|
|
CALL WDialogPutInteger(IDF_INTEGER2,LIMIT)
|
|
CALL WDialogPutInteger(IDF_INTEGER3,NODER)
|
|
|
|
CALL WDialogShow(-1,-1,0,Modal)
|
|
ierr=infoerror(1)
|
|
|
|
do
|
|
!
|
|
IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
|
|
|
|
RETURN
|
|
ELSE
|
|
RETURN
|
|
ENDIF
|
|
enddo
|
|
RETURN
|
|
END
|