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
5 years ago
|
!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
|