|
|
|
|
!IPK LAST UPDATE SEP 23 2015 ADD TESTING FOR REORDERING
|
|
|
|
|
SUBROUTINE ORDDIR
|
|
|
|
|
|
|
|
|
|
USE BLK1MOD
|
|
|
|
|
USE BLK2MOD
|
|
|
|
|
INCLUDE 'BFILES.I90'
|
|
|
|
|
! COMMON /HEDS/ NP,NE,NHTP,NMESS,NBRR,IPSW(15),IRMAIN,ISCRN,icolon(12),IQSW(2),IRDISP,ntempin,igfgsw,igfgswb,ICRIN,IPW1,WIDEL,WIDSCL,itrianout
|
|
|
|
|
REAL*8 XPROJ(100000)
|
|
|
|
|
|
|
|
|
|
NCM=MAXECON
|
|
|
|
|
NCMI=MAXECON
|
|
|
|
|
NAD=0
|
|
|
|
|
MP=0
|
|
|
|
|
IPASS=1
|
|
|
|
|
!
|
|
|
|
|
! GET TABLE OF ELEMENT CONNECTIONS
|
|
|
|
|
!
|
|
|
|
|
CALL KCON(0)
|
|
|
|
|
ISWALL=0
|
|
|
|
|
nmess=47
|
|
|
|
|
IF(.NOT. ALLOCATED(NKEY1)) THEN
|
|
|
|
|
ALLOCATE (NKEY1(MAXE))
|
|
|
|
|
ENDIF
|
|
|
|
|
DIRD=0.
|
|
|
|
|
CALL GETFPN(DIRD)
|
|
|
|
|
! IF(ISWALL .EQ. 0) ISWALL=1
|
|
|
|
|
ISW=0
|
|
|
|
|
DIR=DIRD*3.14159/180.
|
|
|
|
|
|
|
|
|
|
DO N=1,NE
|
|
|
|
|
IF(IMAT(N) .NE. 0) THEN
|
|
|
|
|
XPROJ(N)=XC(N)*COS(DIR)+YC(N)*SIN(DIR)
|
|
|
|
|
ELSE
|
|
|
|
|
XPROJ(N)=1.E15
|
|
|
|
|
ENDIF
|
|
|
|
|
ENDDO
|
|
|
|
|
CALL SORTDB(XPROJ,NKEY1,NE)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
IRDONE=1
|
|
|
|
|
DO N=1,NE
|
|
|
|
|
ILIST(1,N)=NKEY1(N)
|
|
|
|
|
ENDDO
|
|
|
|
|
|
|
|
|
|
! PROCESS INITIAL ORDER
|
|
|
|
|
!
|
|
|
|
|
CALL REORD(ISW,ISWALL)
|
|
|
|
|
! CALL WMessageBox(0,4,1,'REORDERING COMPLETE',' ')
|
|
|
|
|
! CALL WCursorShape(CurArrow )
|
|
|
|
|
!
|
|
|
|
|
! Restore screen
|
|
|
|
|
!
|
|
|
|
|
!pk jan98 WRITE(*,*) 'Press "Return" to restore grapical screen'
|
|
|
|
|
|
|
|
|
|
CALL SHOWORD
|
|
|
|
|
|
|
|
|
|
RETURN
|
|
|
|
|
|
|
|
|
|
END
|
|
|
|
|
|
|
|
|
|
!IPK LAST UPDATE SEP 23 2015 ADD TESTING FOR REORDERING
|
|
|
|
|
SUBROUTINE ORDALL
|
|
|
|
|
|
|
|
|
|
INCLUDE 'BFILES.I90'
|
|
|
|
|
COMMON /HEDS/ NP,NE,NHTP,NMESS,NBRR,IPSW(15),IRMAIN,ISCRN,icolon(12),IQSW(2),IRDISP,ntempin,igfgsw,igfgswb,ICRIN,IPW1,WIDEL,WIDSCL,itrianout
|
|
|
|
|
|
|
|
|
|
ISWALL=1
|
|
|
|
|
nmess=45
|
|
|
|
|
|
|
|
|
|
CALL GETINT(ISWALL)
|
|
|
|
|
IF(ISWALL .EQ. 0) ISWALL=1
|
|
|
|
|
ISW=0
|
|
|
|
|
CALL REORD(ISW,ISWALL)
|
|
|
|
|
CALL WMessageBox(0,4,1,'REORDERING COMPLETE',' ')
|
|
|
|
|
|
|
|
|
|
IRDONE=1
|
|
|
|
|
|
|
|
|
|
RETURN
|
|
|
|
|
|
|
|
|
|
END
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
!IPK LAST UPDATE JULY 11 2005 FIX BUG IN REORDERING
|
|
|
|
|
!ipk last update Nov 18 1996
|
|
|
|
|
! Last change: IPK 12 Jan 98 2:06 pm
|
|
|
|
|
!ipk last update Jan 6 1997 disallow negative sums
|
|
|
|
|
SUBROUTINE ADDORD(ISW)
|
|
|
|
|
!
|
|
|
|
|
! Enter reordering sequence
|
|
|
|
|
!
|
|
|
|
|
USE WINTERACTER
|
|
|
|
|
USE BLK1MOD
|
|
|
|
|
INCLUDE 'BFILES.I90'
|
|
|
|
|
|
|
|
|
|
! INCLUDE 'BLK1.COM'
|
|
|
|
|
!iPK APR94
|
|
|
|
|
COMMON /RECOD/ IRECD,TSPC
|
|
|
|
|
! dimension ilisttmp(100)
|
|
|
|
|
!
|
|
|
|
|
CHARACTER*1 IFLAG
|
|
|
|
|
CHARACTER*14 HEADR
|
|
|
|
|
CHARACTER*60 STRELS
|
|
|
|
|
CHARACTER*80 LIND
|
|
|
|
|
! INTEGER*2 IPAG,NT
|
|
|
|
|
DATA MULTPG/0/
|
|
|
|
|
DATA STRELS/' You have tried to reorder before executing "FILL"'/
|
|
|
|
|
DATA XPRT/0./
|
|
|
|
|
!
|
|
|
|
|
! Test to make sure fill has been executed.
|
|
|
|
|
!
|
|
|
|
|
IF(ISW .NE. 1) THEN
|
|
|
|
|
DO 70 N=1,NE
|
|
|
|
|
IF(IMAT(N) .GT. 0) THEN
|
|
|
|
|
DO 60 M=2,NCORN(N),2
|
|
|
|
|
!ipkoct93
|
|
|
|
|
if(imat(n) .gt. 900) go to 60
|
|
|
|
|
IF(NOP(N,M) .EQ. 0) THEN
|
|
|
|
|
CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK, &
|
|
|
|
|
'You have tried to reorder before executing "FILL"'//CHAR(13) &
|
|
|
|
|
//'Reordering terminated',&
|
|
|
|
|
'UNABLE TO REORDER')
|
|
|
|
|
! CALL SYMBL(0.,7.30,0.20,STRELS,0.,60)
|
|
|
|
|
RETURN
|
|
|
|
|
ENDIF
|
|
|
|
|
60 CONTINUE
|
|
|
|
|
ENDIF
|
|
|
|
|
70 CONTINUE
|
|
|
|
|
ENDIF
|
|
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
IF(ISW .EQ. 0) THEN
|
|
|
|
|
!
|
|
|
|
|
! Change screens if possible
|
|
|
|
|
!
|
|
|
|
|
IF(MULTPG .EQ. 1) THEN
|
|
|
|
|
! IPAG=1
|
|
|
|
|
! NT=SETACTIVEPAGE(IPAG)
|
|
|
|
|
! NT=SETVISUALPAGE(IPAG)
|
|
|
|
|
ELSE
|
|
|
|
|
CALL CLSCRN
|
|
|
|
|
CALL SETD(23)
|
|
|
|
|
ENDIF
|
|
|
|
|
ISWW=0
|
|
|
|
|
CALL WCursorShape(CurHourGlass )
|
|
|
|
|
ISWALL=0
|
|
|
|
|
CALL REORD(ISWW,ISWALL)
|
|
|
|
|
IRDONE=1
|
|
|
|
|
!IPK AUG05 CALL REORD(ISWW)
|
|
|
|
|
CALL WCursorShape(CurArrow )
|
|
|
|
|
!
|
|
|
|
|
! Restore screen
|
|
|
|
|
!
|
|
|
|
|
!pk jan98 WRITE(*,*) 'Press "Return" to restore grapical screen'
|
|
|
|
|
|
|
|
|
|
CALL SHOWORD
|
|
|
|
|
! WRITE(LIND,6002)
|
|
|
|
|
! 6002 FORMAT( 'Press "Return" to restore grapical screen')
|
|
|
|
|
! call rblue
|
|
|
|
|
! call symbl &
|
|
|
|
|
! & (1.1,3.0,0.20,LIND,0.0,80)
|
|
|
|
|
! ndig=1
|
|
|
|
|
! CALL GTCHARX(IFLAG,NDIG,5.0,7.6)
|
|
|
|
|
|
|
|
|
|
!ipk jan98 READ(*,'(A)') IFLAG
|
|
|
|
|
IF(MULTPG .EQ. 1) THEN
|
|
|
|
|
IPAG=0
|
|
|
|
|
! NT=SETACTIVEPAGE(IPAG)
|
|
|
|
|
! NT=SETVISUALPAGE(IPAG)
|
|
|
|
|
ELSE
|
|
|
|
|
CALL CLSCRN
|
|
|
|
|
CALL SETD(2)
|
|
|
|
|
! CALL PLOTS(0)
|
|
|
|
|
!ipk nov97 add (1)
|
|
|
|
|
CALL PLOTOT(1)
|
|
|
|
|
do n=1,ne
|
|
|
|
|
nn=iem(n)
|
|
|
|
|
if(imat(nn) .ne. 0 .AND. IESKP(NN) .EQ. 0) then
|
|
|
|
|
|
|
|
|
|
call fillemC(nn,MOD(N/25,15))
|
|
|
|
|
endif
|
|
|
|
|
! if(mod(n,200) .eq. 0) then
|
|
|
|
|
! READ(*,'(A)') IFLAG
|
|
|
|
|
! endif
|
|
|
|
|
enddo
|
|
|
|
|
ENDIF
|
|
|
|
|
ELSEIF(ISW .EQ. 1) THEN
|
|
|
|
|
100 continue
|
|
|
|
|
! 100 WRITE(HEADR,5000) NLST
|
|
|
|
|
! 5000 FORMAT(' NLIST = ',I5)
|
|
|
|
|
! NHTP = 0
|
|
|
|
|
! NMESS = 13
|
|
|
|
|
! NBRR = 0
|
|
|
|
|
! CALL HEDR
|
|
|
|
|
! CALL SYMBL(0.,7.50,0.20,HEADR,0.,14)
|
|
|
|
|
! XPRT=3.2
|
|
|
|
|
!
|
|
|
|
|
! Form element reordering list by clicking on elements with cursor
|
|
|
|
|
!
|
|
|
|
|
5001 FORMAT(I10)
|
|
|
|
|
! CALL GETINT(NLIST)
|
|
|
|
|
! READ(*,5001,ERR=220) NLIST
|
|
|
|
|
!
|
|
|
|
|
! Find element nearest cursor
|
|
|
|
|
!
|
|
|
|
|
J=0
|
|
|
|
|
200 IBOX=1
|
|
|
|
|
NMESS = 12
|
|
|
|
|
NBRR = 9
|
|
|
|
|
CALL HEDR
|
|
|
|
|
CALL PLOTORDS
|
|
|
|
|
INREORD=1
|
|
|
|
|
CALL PROX(XC,YC,NE,XX,YY,IELEM,IFLAG,IESKP,IBOX)
|
|
|
|
|
INREORD=0
|
|
|
|
|
CALL PLOTORDS
|
|
|
|
|
! write(90,*) 'reord'
|
|
|
|
|
! write(90,'(i10,a10)') ibox,iflag
|
|
|
|
|
IF(IRMAIN .EQ. 1) THEN
|
|
|
|
|
DO J=1,100
|
|
|
|
|
ilisttmp (j)=0
|
|
|
|
|
ENDDO
|
|
|
|
|
RETURN
|
|
|
|
|
ENDIF
|
|
|
|
|
210 IF(IFLAG .EQ. 'c' .and. ibox .ne. 7) THEN
|
|
|
|
|
CALL FILLEM(IELEM)
|
|
|
|
|
XPRT=XPRT+0.5
|
|
|
|
|
IF(XPRT .GT. HSIZE) XPRT=0.
|
|
|
|
|
FPN= IELEM
|
|
|
|
|
CALL NUMBR(XPRT,7.20,0.20,FPN,0.0,-1)
|
|
|
|
|
J=J+1
|
|
|
|
|
ilisttmp (j)=ielem
|
|
|
|
|
! ILIST(NLIST,J)=IELEM
|
|
|
|
|
GO TO 200
|
|
|
|
|
ELSEIF (IFLAG .EQ. 'U') THEN
|
|
|
|
|
ilisttmp (j)=0
|
|
|
|
|
J=J-1
|
|
|
|
|
CALL PLOTOT(1)
|
|
|
|
|
CALL HEDR
|
|
|
|
|
DO IELEM=1,J
|
|
|
|
|
CALL FILLEM(ILISTTMP(IELEM))
|
|
|
|
|
ENDDO
|
|
|
|
|
GO TO 200
|
|
|
|
|
ELSEIF(IFLAG .EQ. 'e') THEN
|
|
|
|
|
! LLIST(NLIST)=J
|
|
|
|
|
nlist=nlst+1
|
|
|
|
|
call getnlist(nlist)
|
|
|
|
|
LLIST(NLIST)=J
|
|
|
|
|
do i=1,j
|
|
|
|
|
ilist(nlist,i)=ilisttmp(i)
|
|
|
|
|
enddo
|
|
|
|
|
IF(NLIST .GT. NLST) NLST=NLIST
|
|
|
|
|
DO J=1,100
|
|
|
|
|
ilisttmp (j)=0
|
|
|
|
|
ENDDO
|
|
|
|
|
GO TO 100
|
|
|
|
|
ELSEIF(IFLAG .EQ. 'a' .or. ibox .eq. 7) THEN
|
|
|
|
|
nlist=nlst+1
|
|
|
|
|
IF(IRECD .NE.2) call getnlist(nlist)
|
|
|
|
|
LLIST(NLIST)=J
|
|
|
|
|
do i=1,j
|
|
|
|
|
ilist(nlist,i)=ilisttmp(i)
|
|
|
|
|
enddo
|
|
|
|
|
IF(NLIST .GT. NLST) NLST=NLIST
|
|
|
|
|
DO J=1,100
|
|
|
|
|
ilisttmp (j)=0
|
|
|
|
|
ENDDO
|
|
|
|
|
GO TO 100
|
|
|
|
|
ELSEIF(IFLAG .EQ. 'q') THEN
|
|
|
|
|
! LLIST(NLIST)=J
|
|
|
|
|
! IF(NLIST .GT. NLST) NLST=NLIST
|
|
|
|
|
! CALL REORD(NLIST)
|
|
|
|
|
! CALL WRTOUT(0)
|
|
|
|
|
DO J=1,100
|
|
|
|
|
ilisttmp (j)=0
|
|
|
|
|
ENDDO
|
|
|
|
|
ENDIF
|
|
|
|
|
ELSEIF(ISW .EQ. 2) THEN
|
|
|
|
|
!
|
|
|
|
|
! Change screens if possible
|
|
|
|
|
!
|
|
|
|
|
IF(MULTPG .EQ. 1) THEN
|
|
|
|
|
IPAG=1
|
|
|
|
|
! NT=SETACTIVEPAGE(IPAG)
|
|
|
|
|
! NT=SETVISUALPAGE(IPAG)
|
|
|
|
|
ELSE
|
|
|
|
|
CALL CLSCRN
|
|
|
|
|
CALL SETD(23)
|
|
|
|
|
ENDIF
|
|
|
|
|
ISWW=NLIST
|
|
|
|
|
ISWALL=0
|
|
|
|
|
CALL REORD(ISWW,ISWALL)
|
|
|
|
|
!IPK AUG05 CALL REORD(ISWW)
|
|
|
|
|
!
|
|
|
|
|
! Restore screen
|
|
|
|
|
!
|
|
|
|
|
!IPK JAN98 WRITE(*,*) 'Press "Return" to restore grapical screen'
|
|
|
|
|
!IPK JAN98 READ(*,'(A)') IFLAG
|
|
|
|
|
CALL SHOWORD
|
|
|
|
|
! WRITE(LIND,6002)
|
|
|
|
|
! call symbl &
|
|
|
|
|
! & (1.1,3.0,0.20,LIND,0.0,80)
|
|
|
|
|
! ndig=1
|
|
|
|
|
! CALL GTCHARX(IFLAG,NDIG,5.0,7.6)
|
|
|
|
|
IF(MULTPG .EQ. 1) THEN
|
|
|
|
|
IPAG=0
|
|
|
|
|
! NT=SETACTIVEPAGE(IPAG)
|
|
|
|
|
! NT=SETVISUALPAGE(IPAG)
|
|
|
|
|
ELSE
|
|
|
|
|
CALL CLSCRN
|
|
|
|
|
CALL SETD(2)
|
|
|
|
|
! CALL PLOTS(0)
|
|
|
|
|
!ipk nov97 add (1)
|
|
|
|
|
CALL PLOTOT(1)
|
|
|
|
|
ENDIF
|
|
|
|
|
ENDIF
|
|
|
|
|
220 RETURN
|
|
|
|
|
END
|
|
|
|
|
SUBROUTINE REORD (ISW,ISWALL)
|
|
|
|
|
!
|
|
|
|
|
! DRIVING ROUTINE TO REORDER ELEMENTS
|
|
|
|
|
!
|
|
|
|
|
USE BLK1MOD
|
|
|
|
|
USE BLK2MOD
|
|
|
|
|
! INCLUDE 'BLK1.COM'
|
|
|
|
|
! INCLUDE 'BLK2.COM'
|
|
|
|
|
!
|
|
|
|
|
! INITIALIZE
|
|
|
|
|
!
|
|
|
|
|
IF(IECHG .EQ. 0) THEN
|
|
|
|
|
NCM=MAXECON
|
|
|
|
|
NCMI=MAXECON
|
|
|
|
|
NAD=0
|
|
|
|
|
MP=0
|
|
|
|
|
IPASS=1
|
|
|
|
|
!
|
|
|
|
|
! GET TABLE OF ELEMENT CONNECTIONS
|
|
|
|
|
!
|
|
|
|
|
CALL KCON(0)
|
|
|
|
|
!
|
|
|
|
|
! SETUP NELIM. IDENTIFIES 3 NODE ELEMENTS OR JUNCTIONS WHEN = 1
|
|
|
|
|
!
|
|
|
|
|
DO 250 N=1,NE
|
|
|
|
|
IF(IMAT(N) .NE. 0) THEN
|
|
|
|
|
!ipkoct93
|
|
|
|
|
IF(NCORN(N) .EQ. 3 .OR. (IMAT(N) .GT. 900 .and. &
|
|
|
|
|
& ncorn(n) .ne. 8)) THEN
|
|
|
|
|
NELIM(N)=1
|
|
|
|
|
ELSE
|
|
|
|
|
NELIM(N)=0
|
|
|
|
|
ENDIF
|
|
|
|
|
ELSE
|
|
|
|
|
NELIM(N)=1
|
|
|
|
|
ENDIF
|
|
|
|
|
250 CONTINUE
|
|
|
|
|
IECHG=1
|
|
|
|
|
!IPK MAY03
|
|
|
|
|
ICHG=0
|
|
|
|
|
|
|
|
|
|
!
|
|
|
|
|
! PROCESS INITIAL ORDER
|
|
|
|
|
!
|
|
|
|
|
IF(ISW .EQ. 0) THEN
|
|
|
|
|
CALL ORDER(ISWALL)
|
|
|
|
|
ISW=ISW+1
|
|
|
|
|
ENDIF
|
|
|
|
|
ENDIF
|
|
|
|
|
IF(ISW .EQ. 0) ISW=1
|
|
|
|
|
!
|
|
|
|
|
! OTHERWISE RESET MLIST
|
|
|
|
|
!
|
|
|
|
|
305 DO 310 N=1,NAE
|
|
|
|
|
MLIST(N)=0
|
|
|
|
|
310 END DO
|
|
|
|
|
!
|
|
|
|
|
! SET STARTING SEQUENCE
|
|
|
|
|
!
|
|
|
|
|
|
|
|
|
|
!IPK AUG05
|
|
|
|
|
IF(ISWALL .EQ. 0) THEN
|
|
|
|
|
|
|
|
|
|
NN=1
|
|
|
|
|
DO 320 N=1,NAE
|
|
|
|
|
MLIST(NN)=ILIST(ISW,N)
|
|
|
|
|
IF(NN .GT. 1) THEN
|
|
|
|
|
IF(MLIST(NN) .EQ. MLIST(NN-1)) THEN
|
|
|
|
|
NN=NN-1
|
|
|
|
|
ENDIF
|
|
|
|
|
!IPK JUL05 FIX BUG MOVE DOWN NN=NN+1
|
|
|
|
|
ENDIF
|
|
|
|
|
NN=NN+1
|
|
|
|
|
! write(90,*) 'Entries forming start of list',n,mlist(n)
|
|
|
|
|
IF(MLIST(N) .EQ. 0) GO TO 325
|
|
|
|
|
320 END DO
|
|
|
|
|
ELSE
|
|
|
|
|
322 CONTINUE
|
|
|
|
|
IF(MOD(ISW,ISWALL) .EQ. 0) THEN
|
|
|
|
|
MLIST(1)=ISW
|
|
|
|
|
ELSE
|
|
|
|
|
ISW=ISW+1
|
|
|
|
|
GO TO 322
|
|
|
|
|
ENDIF
|
|
|
|
|
|
|
|
|
|
ENDIF
|
|
|
|
|
!
|
|
|
|
|
325 MP=0
|
|
|
|
|
NAD=0
|
|
|
|
|
!
|
|
|
|
|
! RESET NODE TO ELEMENT LIST
|
|
|
|
|
!
|
|
|
|
|
DO 340 N=1,NP
|
|
|
|
|
DO 335 M=1,NCM
|
|
|
|
|
IF(NECON(N,M) .EQ. 0) GO TO 338
|
|
|
|
|
335 CONTINUE
|
|
|
|
|
338 NDELM(N)=M-1
|
|
|
|
|
340 END DO
|
|
|
|
|
!
|
|
|
|
|
! RESET ELEMENT CONNECTIONS
|
|
|
|
|
!
|
|
|
|
|
DO 350 N=1,NE
|
|
|
|
|
DO 350 M=1,NCMI
|
|
|
|
|
ICON(N,M)=IABS(ICON(N,M))
|
|
|
|
|
350 CONTINUE
|
|
|
|
|
!
|
|
|
|
|
! GO TO PROCESS THIS SEQUENCE
|
|
|
|
|
!
|
|
|
|
|
IF(MLIST(1) .GT. 0) THEN
|
|
|
|
|
CALL ORDER(ISWALL)
|
|
|
|
|
ISW=ISW+1
|
|
|
|
|
ELSE
|
|
|
|
|
GO TO 600
|
|
|
|
|
ENDIF
|
|
|
|
|
IF(ISWALL .EQ. 0) THEN
|
|
|
|
|
IF(ISW .GT. NLST) GO TO 600
|
|
|
|
|
ELSE
|
|
|
|
|
WRITE(90,*) MLIST(1),MTSUMSV(NSEQ),NFWSV(NSEQ),IEM(1),MRSUM
|
|
|
|
|
|
|
|
|
|
IF(ISW .GT. NE) GO TO 600
|
|
|
|
|
ENDIF
|
|
|
|
|
GO TO 305
|
|
|
|
|
!
|
|
|
|
|
! PRINT FINAL ORDER
|
|
|
|
|
!
|
|
|
|
|
600 WRITE(90,6040) (IEM(K),K=1,NAE)
|
|
|
|
|
6040 FORMAT(//' SELECTED ELEMENT ORDER'/(10I6))
|
|
|
|
|
!
|
|
|
|
|
! RETURN TO MAIN
|
|
|
|
|
!
|
|
|
|
|
RETURN
|
|
|
|
|
END
|
|
|
|
|
SUBROUTINE ORDER(ISWALL)
|
|
|
|
|
!
|
|
|
|
|
! FIND ORDER AND FRONT SUM FOR A GIVEN START POINT
|
|
|
|
|
!
|
|
|
|
|
USE BLK1MOD
|
|
|
|
|
USE BLK2MOD
|
|
|
|
|
! INCLUDE 'BLK1.COM'
|
|
|
|
|
! INCLUDE 'BLK2.COM'
|
|
|
|
|
!
|
|
|
|
|
! SET LIST OF INCORPORATED NODES
|
|
|
|
|
!
|
|
|
|
|
DO 200 N=1,NP
|
|
|
|
|
200 NINC(N)=0
|
|
|
|
|
!
|
|
|
|
|
! SET COUNTER ON ELEMENTS
|
|
|
|
|
!
|
|
|
|
|
KNT=0
|
|
|
|
|
MTSUM=0
|
|
|
|
|
!ipk feb97 add mtsum1
|
|
|
|
|
mtsum1=0
|
|
|
|
|
!IPK MAY94 LINE ADDED
|
|
|
|
|
NFWSAV=0
|
|
|
|
|
!
|
|
|
|
|
! PROCESS THROUGH ELEMENTS
|
|
|
|
|
!
|
|
|
|
|
300 CONTINUE
|
|
|
|
|
!
|
|
|
|
|
! SET MLIST FROM INPUT IF NON-ZERO WE MUST FIND KREC
|
|
|
|
|
!
|
|
|
|
|
KREC=MLIST(KNT+1)
|
|
|
|
|
!
|
|
|
|
|
! GET NEXT ELEMENT TO ADDED
|
|
|
|
|
!
|
|
|
|
|
CALL MOVFNT(KREC,ISWALL)
|
|
|
|
|
|
|
|
|
|
!ipk mar04
|
|
|
|
|
IF(KREC .lt. 0) THEN
|
|
|
|
|
write(90,*) 'krec',knt,mlist(knt)
|
|
|
|
|
MTSUM=9999999999999
|
|
|
|
|
MTSUM1=9999999999999
|
|
|
|
|
GO TO 310
|
|
|
|
|
ENDIF
|
|
|
|
|
!
|
|
|
|
|
! SAVE SELECTED VALUE
|
|
|
|
|
!
|
|
|
|
|
MLIST(KNT+1)=KREC
|
|
|
|
|
KNT=KNT+1
|
|
|
|
|
!
|
|
|
|
|
! UPDATE FRONT AND CONNECTION TABLES
|
|
|
|
|
!
|
|
|
|
|
CALL UPFNT(KREC)
|
|
|
|
|
!
|
|
|
|
|
! TEST FOR FULL SET OF ELEMENTS
|
|
|
|
|
!
|
|
|
|
|
IF (KNT.LT.NAE) GO TO 300
|
|
|
|
|
WRITE(90,9000) KREC,MTSUM,MSUM,MP,NAD
|
|
|
|
|
9000 FORMAT(' KREC MTSUM MSUM MP NAD'/I6,2I15,2I5)
|
|
|
|
|
!
|
|
|
|
|
! FOR COMPLETE ORDER CHECK IF IT IS IMPROVEMENT
|
|
|
|
|
!
|
|
|
|
|
!IPK MAR04
|
|
|
|
|
310 CONTINUE
|
|
|
|
|
CALL CHKOUT(ISWALL)
|
|
|
|
|
!
|
|
|
|
|
! FINISHED
|
|
|
|
|
!
|
|
|
|
|
RETURN
|
|
|
|
|
END
|
|
|
|
|
SUBROUTINE MOVFNT(KREC,ISWALL)
|
|
|
|
|
!
|
|
|
|
|
! GET ELEMENT THAT INCREASES FRONT WIDTH LEAST
|
|
|
|
|
!
|
|
|
|
|
USE BLK1MOD
|
|
|
|
|
USE BLK2MOD
|
|
|
|
|
! INCLUDE 'BLK1.COM'
|
|
|
|
|
! INCLUDE 'BLK2.COM'
|
|
|
|
|
INTEGER*8 MSAV,MSA
|
|
|
|
|
CHARACTER*80 LIND
|
|
|
|
|
CHARACTER*1 JUNK
|
|
|
|
|
!
|
|
|
|
|
! INITIALIZE
|
|
|
|
|
!
|
|
|
|
|
MSAV=99999999
|
|
|
|
|
NSN=99999
|
|
|
|
|
!
|
|
|
|
|
! SKIP IF KREC ALREADY DEFINED
|
|
|
|
|
!
|
|
|
|
|
IF(KREC .GT. 0) GO TO 310
|
|
|
|
|
!
|
|
|
|
|
! SEARCH ADJACENT ELEMENTS
|
|
|
|
|
!
|
|
|
|
|
NTST=NITST
|
|
|
|
|
260 NFD=0
|
|
|
|
|
if(nad .eq. 0) then
|
|
|
|
|
!IPK JAN98 write(*,*) 'nad in trouble type q and press return,enxt(1)',enxt(1)
|
|
|
|
|
!IPK JAN98 read(*,*) njunk
|
|
|
|
|
!ipk mar04 WRITE(LIND,6002)krec,nsn
|
|
|
|
|
!ipk mar04 6002 FORMAT( 'NAD =0 illegal connection. krec,nsn',2i5,'Type q to exit')
|
|
|
|
|
!ipk mar04 call symbl &
|
|
|
|
|
!ipk mar04 & (1.1,3.0,0.20,LIND,0.0,80)
|
|
|
|
|
!ipk mar04 ndig=1
|
|
|
|
|
!ipk mar04 CALL GTCHARX(JUNK,NDIG,5.0,7.6)
|
|
|
|
|
!ipk mar04 stop
|
|
|
|
|
IF(ISWALL .GT. 0) THEN
|
|
|
|
|
KREC=-1
|
|
|
|
|
RETURN
|
|
|
|
|
ENDIF
|
|
|
|
|
write(90,*) nae
|
|
|
|
|
write(90,'(5(i7,i6))') (n,mlist(n),n=1,ne)
|
|
|
|
|
CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK, &
|
|
|
|
|
'No active adjacent elements found '//CHAR(13) &
|
|
|
|
|
//'Possible network error.'//CHAR(13) &
|
|
|
|
|
//'or erroneous starting element'//CHAR(13) &
|
|
|
|
|
//'Reordering terminated',&
|
|
|
|
|
'ERROR')
|
|
|
|
|
krec=-1
|
|
|
|
|
return
|
|
|
|
|
endif
|
|
|
|
|
DO 300 K=1,NAD
|
|
|
|
|
NEL=ENXT(K)
|
|
|
|
|
IF(NTST .EQ. 0) GO TO 270
|
|
|
|
|
IF(NELIM(NEL) .EQ. 1) GO TO 300
|
|
|
|
|
270 CONTINUE
|
|
|
|
|
NFD=1
|
|
|
|
|
!
|
|
|
|
|
! GET SUMS FOR NEL
|
|
|
|
|
!
|
|
|
|
|
CALL SUMIT(NEL)
|
|
|
|
|
!
|
|
|
|
|
! MSA IS THE AVERAGE PER NODE ADDED
|
|
|
|
|
!
|
|
|
|
|
MSA=MSUM
|
|
|
|
|
! MSA=9999999
|
|
|
|
|
IF(NDP .GT. 1) MSA=(MSUM+NDP/2)/NDP
|
|
|
|
|
!
|
|
|
|
|
! CHECK IF IT IS LESS
|
|
|
|
|
!
|
|
|
|
|
IF (MSA.GT.MSAV) GO TO 300
|
|
|
|
|
IF (MSA.LT.MSAV) GO TO 280
|
|
|
|
|
!
|
|
|
|
|
! IF EQUAL TAKE CASE WITH LEAST NODES ADDED
|
|
|
|
|
!
|
|
|
|
|
IF (NDP.GE.NSN) GO TO 300
|
|
|
|
|
280 KREC=NEL
|
|
|
|
|
NSN=NDP
|
|
|
|
|
MSAV=MSA
|
|
|
|
|
300 END DO
|
|
|
|
|
IF(NFD .EQ. 0) THEN
|
|
|
|
|
NTST=0
|
|
|
|
|
GO TO 260
|
|
|
|
|
ENDIF
|
|
|
|
|
310 CONTINUE
|
|
|
|
|
!
|
|
|
|
|
! GET INFORMATION AGAIN FOR SELECTED ELEMENT
|
|
|
|
|
!
|
|
|
|
|
CALL SUMIT(KREC)
|
|
|
|
|
!IPK MAY94 ADD A LINE
|
|
|
|
|
IF(NFWS .GT. NFWSAV) NFWSAV=NFWS
|
|
|
|
|
IF(MSUM .EQ. 9999999) MSUM=0
|
|
|
|
|
MTSUM=MTSUM+MSUM
|
|
|
|
|
!ipk feb97 add pseudo double precision
|
|
|
|
|
320 continue
|
|
|
|
|
! if(mtsum .gt. 100000000) then
|
|
|
|
|
! mtsum1=mtsum1+1
|
|
|
|
|
! mtsum=mtsum-100000000
|
|
|
|
|
! go to 320
|
|
|
|
|
! endif
|
|
|
|
|
!
|
|
|
|
|
! UPDATE LIST OF NODES IN FRONT
|
|
|
|
|
!
|
|
|
|
|
MPN=MP
|
|
|
|
|
IF (MP.EQ.0) GO TO 420
|
|
|
|
|
IF (NDP.EQ.0) GO TO 420
|
|
|
|
|
!
|
|
|
|
|
! REMOVE THE DROPPED NODES
|
|
|
|
|
!
|
|
|
|
|
! ict2=ict2+1
|
|
|
|
|
! write(88,*) ict2,'z',krec,ndp,(ndrop(n),n=1,ndp)
|
|
|
|
|
DO 400 N=1,NDP
|
|
|
|
|
!
|
|
|
|
|
! FIND THE NODE TO BE DROPPED IN LIST
|
|
|
|
|
!
|
|
|
|
|
DO 390 M=1,MP
|
|
|
|
|
IF (LIST(M).NE.NDROP(N)) GO TO 390
|
|
|
|
|
LIST(M)=-LIST(M)
|
|
|
|
|
GO TO 400
|
|
|
|
|
390 CONTINUE
|
|
|
|
|
400 END DO
|
|
|
|
|
!
|
|
|
|
|
! NOW DROP THEM
|
|
|
|
|
!
|
|
|
|
|
MPN=0
|
|
|
|
|
DO 410 M=1,MP
|
|
|
|
|
IF (LIST(M).LT.0) GO TO 410
|
|
|
|
|
MPN=MPN+1
|
|
|
|
|
LIST(MPN)=LIST(M)
|
|
|
|
|
410 END DO
|
|
|
|
|
!
|
|
|
|
|
! NOW ADD NEWLY GENERATED NODES
|
|
|
|
|
!
|
|
|
|
|
IF (NNEW.EQ.0) GO TO 435
|
|
|
|
|
420 DO 430 M=1,NNEW
|
|
|
|
|
!
|
|
|
|
|
! FIRST SEE IF LNEW IS IN DROP LIST
|
|
|
|
|
!
|
|
|
|
|
IF(NDP .EQ. 0) GO TO 428
|
|
|
|
|
DO 425 N=1,NDP
|
|
|
|
|
IF(LNEW(M) .EQ. NDROP(N)) GO TO 430
|
|
|
|
|
425 CONTINUE
|
|
|
|
|
428 CONTINUE
|
|
|
|
|
MPN=MPN+1
|
|
|
|
|
LIST(MPN)=LNEW(M)
|
|
|
|
|
K=LNEW(M)
|
|
|
|
|
NINC(K)=1
|
|
|
|
|
430 END DO
|
|
|
|
|
!
|
|
|
|
|
! REDUCE COUNT OF ELEMENTS ACQUIRED AT THE NODES OF THE ELEMENT
|
|
|
|
|
!
|
|
|
|
|
435 CONTINUE
|
|
|
|
|
MP=MPN
|
|
|
|
|
! ict1=ict1+1
|
|
|
|
|
! write(85,*) ict1,'x',krec,mp,(list(n),n=1,mp)
|
|
|
|
|
DO 440 K=1,8
|
|
|
|
|
N=NOP(KREC,K)
|
|
|
|
|
IF (N.EQ.0) GO TO 440
|
|
|
|
|
NDELM(N)=NDELM(N)-1
|
|
|
|
|
440 END DO
|
|
|
|
|
RETURN
|
|
|
|
|
END
|
|
|
|
|
SUBROUTINE UPFNT(KREC)
|
|
|
|
|
!
|
|
|
|
|
! DEFINE NEW INFO ON FRONT
|
|
|
|
|
!
|
|
|
|
|
USE BLK1MOD
|
|
|
|
|
USE BLK2MOD
|
|
|
|
|
! INCLUDE 'BLK1.COM'
|
|
|
|
|
! INCLUDE 'BLK2.COM'
|
|
|
|
|
!
|
|
|
|
|
! SET ICON ENTRIES NEGATIVE TO SAY THIS ELEMENT ALREADY ADDED
|
|
|
|
|
!
|
|
|
|
|
DO 450 M=1,NCMI
|
|
|
|
|
K=ICON(KREC,M)
|
|
|
|
|
IF (K.EQ.0) GO TO 460
|
|
|
|
|
IF (K.LT.0) GO TO 450
|
|
|
|
|
DO 430 J=1,NCMI
|
|
|
|
|
IF (ICON(K,J).NE.KREC) GO TO 430
|
|
|
|
|
ICON(K,J)=-ICON(K,J)
|
|
|
|
|
GO TO 450
|
|
|
|
|
430 CONTINUE
|
|
|
|
|
450 END DO
|
|
|
|
|
!
|
|
|
|
|
! UPDATE LIST OF ELEMENTS STILL IN FRONT
|
|
|
|
|
!
|
|
|
|
|
460 MNAD=0
|
|
|
|
|
!
|
|
|
|
|
! FIRST ELIMINATE KREC
|
|
|
|
|
!
|
|
|
|
|
IF(NAD .EQ. 0) GO TO 510
|
|
|
|
|
DO 500 K=1,NAD
|
|
|
|
|
IF (ENXT(K).EQ.KREC) GO TO 500
|
|
|
|
|
MNAD=MNAD+1
|
|
|
|
|
ENXT(MNAD)=ENXT(K)
|
|
|
|
|
500 END DO
|
|
|
|
|
510 CONTINUE
|
|
|
|
|
NAD=MNAD
|
|
|
|
|
!
|
|
|
|
|
! NOW ADD NEW ELEMENTS
|
|
|
|
|
!
|
|
|
|
|
DO 520 J=1,NCMI
|
|
|
|
|
K=ICON(KREC,J)
|
|
|
|
|
IF (K.LE.0) GO TO 520
|
|
|
|
|
!
|
|
|
|
|
! CHECK OF -K- ALREADY IN LIST
|
|
|
|
|
!
|
|
|
|
|
DO 515 M=1,NAD
|
|
|
|
|
IF(K .EQ. ENXT(M)) GO TO 520
|
|
|
|
|
515 CONTINUE
|
|
|
|
|
MNAD=MNAD+1
|
|
|
|
|
ENXT(MNAD)=K
|
|
|
|
|
520 END DO
|
|
|
|
|
NAD=MNAD
|
|
|
|
|
RETURN
|
|
|
|
|
END
|
|
|
|
|
SUBROUTINE SUMIT(NEL)
|
|
|
|
|
!
|
|
|
|
|
! DEVELOP SUMS FOR MAKING ELIMINATION CHOICE
|
|
|
|
|
!
|
|
|
|
|
USE BLK1MOD
|
|
|
|
|
USE BLK2MOD
|
|
|
|
|
INTEGER*8 MSUMP
|
|
|
|
|
! INCLUDE 'BLK1.COM'
|
|
|
|
|
! INCLUDE 'BLK2.COM'
|
|
|
|
|
!
|
|
|
|
|
! LOCATE NEW NODES
|
|
|
|
|
!
|
|
|
|
|
NDP=0
|
|
|
|
|
NNEW=0
|
|
|
|
|
DO 280 K=1,8
|
|
|
|
|
N=NOP(NEL,K)
|
|
|
|
|
IF (N.EQ.0) GO TO 280
|
|
|
|
|
!
|
|
|
|
|
! TEST WHETHER THIS NODE ALREADY INCORPORATED
|
|
|
|
|
!
|
|
|
|
|
IF (NINC(N).EQ.1) GO TO 260
|
|
|
|
|
NNEW=NNEW+1
|
|
|
|
|
LNEW(NNEW)=N
|
|
|
|
|
!
|
|
|
|
|
! NOW TEST IF THE NODE IS COMPLETELY FORMED
|
|
|
|
|
!
|
|
|
|
|
260 IF (NDELM(N).GT.1) GO TO 280
|
|
|
|
|
NDP=NDP+1
|
|
|
|
|
NDROP(NDP)=N
|
|
|
|
|
280 END DO
|
|
|
|
|
!
|
|
|
|
|
! IMMEDIATELY ON ADDING NEW FRONT SIZE IS
|
|
|
|
|
!
|
|
|
|
|
NFW=MP+NNEW
|
|
|
|
|
!IPK MAY94 ADD A LINE
|
|
|
|
|
NFWS=NFW
|
|
|
|
|
!
|
|
|
|
|
! NOW TAKE OUT ALL WE CAN
|
|
|
|
|
!
|
|
|
|
|
MSUM=99999999
|
|
|
|
|
! MSUM=0
|
|
|
|
|
IF(NDP .EQ. 0) RETURN
|
|
|
|
|
MSUMP=0
|
|
|
|
|
DO 300 K=1,NDP
|
|
|
|
|
MSUMP=MSUMP+NFW**2
|
|
|
|
|
NFW=NFW-1
|
|
|
|
|
300 END DO
|
|
|
|
|
msum=msump
|
|
|
|
|
if(msum .gt. 99999999) THEN
|
|
|
|
|
write(90,*) ndp,msum,nfw,nel
|
|
|
|
|
ENDIF
|
|
|
|
|
RETURN
|
|
|
|
|
END
|
|
|
|
|
SUBROUTINE CHKOUT(ISWALL)
|
|
|
|
|
!
|
|
|
|
|
! CHECK FINAL TOTAL SAVE ORDER IF BETTER
|
|
|
|
|
!
|
|
|
|
|
USE BLK1MOD
|
|
|
|
|
USE BLK2MOD
|
|
|
|
|
! INCLUDE 'BLK1.COM'
|
|
|
|
|
! INCLUDE 'BLK2.COM'
|
|
|
|
|
CHARACTER*80 LIND
|
|
|
|
|
!
|
|
|
|
|
DATA ITIME/0/
|
|
|
|
|
IF(ITIME .EQ. 0) THEN
|
|
|
|
|
! call rblue
|
|
|
|
|
! call clscrn
|
|
|
|
|
! YT=7.5
|
|
|
|
|
! WRITE(90,6010) mtsum1,MTSUM,NFWSAV
|
|
|
|
|
! WRITE(LIND,6010) mtsum1,MTSUM,NFWSAV
|
|
|
|
|
! WRITE(90,6010) MTSUM,NFWSAV
|
|
|
|
|
! WRITE(LIND,6010) MTSUM,NFWSAV
|
|
|
|
|
! call symbl &
|
|
|
|
|
! & (0.1,YT,0.20,LIND,0.0,80)
|
|
|
|
|
NSEQ=0
|
|
|
|
|
MTSUMSV(NSEQ)=MTSUM
|
|
|
|
|
NFWSV(NSEQ)=NFWSAV
|
|
|
|
|
! elseif(mtsum1 .gt. mrsum1) then
|
|
|
|
|
! WRITE(90,6020) mtsum1,MTSUM,NFWSAV
|
|
|
|
|
! WRITE(LIND,6020) mtsum1,MTSUM,NFWSAV
|
|
|
|
|
! YT=YT-0.3
|
|
|
|
|
! call symbl &
|
|
|
|
|
! & (0.1,YT,0.20,LIND,0.0,80)
|
|
|
|
|
! RETURN
|
|
|
|
|
! elseif(mtsum1 .eq. mrsum1) then
|
|
|
|
|
!IPK AUG05 ELSE
|
|
|
|
|
ELSEIF(ISWALL .EQ. 0) THEN
|
|
|
|
|
NSEQ=NSEQ+1
|
|
|
|
|
MTSUMSV(NSEQ)=MTSUM
|
|
|
|
|
NFWSV(NSEQ)=NFWSAV
|
|
|
|
|
if(mtsum .ge. mrsum .AND. MRSUM .GT. 0) then
|
|
|
|
|
! WRITE(90,6020) mtsum1,MTSUM,NFWSAV
|
|
|
|
|
! WRITE(LIND,6020) mtsum1,MTSUM,NFWSAV
|
|
|
|
|
! WRITE(90,6020) MTSUM,NFWSAV
|
|
|
|
|
! WRITE(LIND,6020) MTSUM,NFWSAV
|
|
|
|
|
! YT=YT-0.3
|
|
|
|
|
! call symbl &
|
|
|
|
|
! & (0.1,YT,0.20,LIND,0.0,80)
|
|
|
|
|
RETURN
|
|
|
|
|
else
|
|
|
|
|
! WRITE(90,6020) mtsum1,MTSUM,NFWSAV
|
|
|
|
|
! WRITE(LIND,6020) mtsum1,MTSUM,NFWSAV
|
|
|
|
|
! WRITE(90,6020) MTSUM,NFWSAV
|
|
|
|
|
! WRITE(LIND,6020) MTSUM,NFWSAV
|
|
|
|
|
! YT=YT-0.3
|
|
|
|
|
! call symbl &
|
|
|
|
|
! & (0.1,YT,0.20,LIND,0.0,80)
|
|
|
|
|
endif
|
|
|
|
|
! ELSE
|
|
|
|
|
! WRITE(90,6020) mtsum1,MTSUM,NFWSAV
|
|
|
|
|
! WRITE(LIND,6020) mtsum1,MTSUM,NFWSAV
|
|
|
|
|
! WRITE(90,6020) MTSUM,NFWSAV
|
|
|
|
|
! WRITE(LIND,6020) MTSUM,NFWSAV
|
|
|
|
|
! YT=YT-0.3
|
|
|
|
|
! call symbl &
|
|
|
|
|
! & (0.1,YT,0.20,LIND,0.0,80)
|
|
|
|
|
ELSE
|
|
|
|
|
! NSEQ=NSEQ+1
|
|
|
|
|
if(mtsum .ge. mrsum .AND. MRSUM .GT. 0) then
|
|
|
|
|
NSEQ=0
|
|
|
|
|
MTSUMSV(NSEQ)=MTSUM
|
|
|
|
|
NFWSV(NSEQ)=NFWSAV
|
|
|
|
|
RETURN
|
|
|
|
|
ELSE
|
|
|
|
|
NSEQ=0
|
|
|
|
|
MTSUMSV(NSEQ)=MTSUM
|
|
|
|
|
NFWSV(NSEQ)=NFWSAV
|
|
|
|
|
endif
|
|
|
|
|
ENDIF
|
|
|
|
|
! mrsum1=mtsum1
|
|
|
|
|
MRSUM=MTSUM
|
|
|
|
|
ITIME=1
|
|
|
|
|
! 6010 FORMAT('ORDERING SUM, ORIGINAL ELEMENT ORDER, MAX FRONT' &
|
|
|
|
|
! &,I4,I8.8,I7)
|
|
|
|
|
! 6020 FORMAT('ORDERING SUM, LATEST START POINT, MAX FRONT' &
|
|
|
|
|
! &,I4,I8.8,I7)
|
|
|
|
|
6010 FORMAT('ORDERING SUM, ORIGINAL ELEMENT ORDER, MAX FRONT' &
|
|
|
|
|
&,I12,I7)
|
|
|
|
|
6020 FORMAT('ORDERING SUM, LATEST START POINT, MAX FRONT' &
|
|
|
|
|
&,I12,I7)
|
|
|
|
|
!ipk feb97 end changes
|
|
|
|
|
!
|
|
|
|
|
! COPY ORDER
|
|
|
|
|
!
|
|
|
|
|
DO 300 N=1,NAE
|
|
|
|
|
IEM(N)=MLIST(N)
|
|
|
|
|
300 END DO
|
|
|
|
|
!
|
|
|
|
|
! FILL IEM ARRAY
|
|
|
|
|
!
|
|
|
|
|
NAEP=NAE+1
|
|
|
|
|
DO 400 N=1,NE
|
|
|
|
|
IF(IMAT(N) .EQ. 0) THEN
|
|
|
|
|
IEM(NAEP)=N
|
|
|
|
|
NAEP=NAEP+1
|
|
|
|
|
ENDIF
|
|
|
|
|
400 END DO
|
|
|
|
|
RETURN
|
|
|
|
|
END
|
|
|
|
|
SUBROUTINE KCON(isw1)
|
|
|
|
|
!
|
|
|
|
|
! ESTABLISH ELEMENT CONNECTED TO ELEMENT TABLE
|
|
|
|
|
!
|
|
|
|
|
USE BLK1MOD
|
|
|
|
|
USE BLK2MOD
|
|
|
|
|
! INCLUDE 'BLK1.COM'
|
|
|
|
|
! INCLUDE 'BLK2.COM'
|
|
|
|
|
!
|
|
|
|
|
! INITIALIZE
|
|
|
|
|
!
|
|
|
|
|
DO 200 J=1,NCM
|
|
|
|
|
DO 200 N=1,NP
|
|
|
|
|
200 NECON(N,J)=0
|
|
|
|
|
DO 210 J=1,NCMI
|
|
|
|
|
DO 210 M=1,NE
|
|
|
|
|
210 ICON(M,J)=0
|
|
|
|
|
DO 230 N=1,NP
|
|
|
|
|
230 NDELM(N)=0
|
|
|
|
|
!
|
|
|
|
|
! FORM TABLE OF ELEMENTS CONNECTED TO EACH NODE
|
|
|
|
|
!
|
|
|
|
|
DO 300 M=1,NE
|
|
|
|
|
IF(IMAT(M) .EQ. 0) GO TO 300
|
|
|
|
|
if(isw1 .eq. 1) then
|
|
|
|
|
if(imat(m) .eq. 999) go to 300
|
|
|
|
|
endif
|
|
|
|
|
DO 280 K=1,8
|
|
|
|
|
N=NOP(M,K)
|
|
|
|
|
IF (N .GT. 0) THEN
|
|
|
|
|
NDELM(N)=NDELM(N)+1
|
|
|
|
|
J=NDELM(N)
|
|
|
|
|
NECON(N,J)=M
|
|
|
|
|
!ipkoct93 ELSE
|
|
|
|
|
!ipkoct93 GO TO 300
|
|
|
|
|
ENDIF
|
|
|
|
|
280 CONTINUE
|
|
|
|
|
300 END DO
|
|
|
|
|
! do n=1,np
|
|
|
|
|
! write(87,'(31i6)') n,(necon(n,j),j=1,ncmi)
|
|
|
|
|
! enddo
|
|
|
|
|
! write(89,*) 'yy'
|
|
|
|
|
! DO N=1,NP
|
|
|
|
|
! WRITE(89,*) 'NDELM',N,NDELM(N)
|
|
|
|
|
! ENDDO
|
|
|
|
|
!
|
|
|
|
|
! CONVERT TABLE TO ELEMENT TO ELEMENT CONNECTION
|
|
|
|
|
!
|
|
|
|
|
DO 600 N=1,NP
|
|
|
|
|
!
|
|
|
|
|
! PLACE PAIRS OF ENTRIES FOR EACH NODE INTO APPROPRIATE ROWS
|
|
|
|
|
!
|
|
|
|
|
NL=NDELM(N)-1
|
|
|
|
|
!
|
|
|
|
|
! SKIP OUT WHEN ONE ELEMENT OR LESS NODE
|
|
|
|
|
!
|
|
|
|
|
IF (NL.LE.0) GO TO 600
|
|
|
|
|
DO 420 J=1,NL
|
|
|
|
|
M=NECON(N,J)
|
|
|
|
|
!
|
|
|
|
|
! PROCESS SECOND ELEMENT IN A GIVEN ROW
|
|
|
|
|
!
|
|
|
|
|
DO 370 K=J+1,NL+1
|
|
|
|
|
MR=NECON(N,K)
|
|
|
|
|
MS=M
|
|
|
|
|
!
|
|
|
|
|
! PROCESS EACH DIRECTION OF CONNECTION
|
|
|
|
|
!
|
|
|
|
|
DO 360 MX=1,2
|
|
|
|
|
!
|
|
|
|
|
! SEARCH IN CASE CONNECTION ALREADY FOUND
|
|
|
|
|
!
|
|
|
|
|
DO 350 L=1,NCMI
|
|
|
|
|
IF (ICON(MS,L).NE.0) GO TO 345
|
|
|
|
|
ICON(MS,L)=MR
|
|
|
|
|
GO TO 355
|
|
|
|
|
345 IF (ICON(MS,L).EQ.MR) GO TO 355
|
|
|
|
|
350 CONTINUE
|
|
|
|
|
!
|
|
|
|
|
! REVERSE MR-MS FOR SECOND PASS
|
|
|
|
|
!
|
|
|
|
|
355 CONTINUE
|
|
|
|
|
MS=MR
|
|
|
|
|
MR=M
|
|
|
|
|
360 CONTINUE
|
|
|
|
|
!
|
|
|
|
|
! END LOOP ON SECOND ELEMENT
|
|
|
|
|
!
|
|
|
|
|
370 CONTINUE
|
|
|
|
|
!
|
|
|
|
|
! END LOOP ON FIRST ELEMENT
|
|
|
|
|
!
|
|
|
|
|
420 CONTINUE
|
|
|
|
|
!
|
|
|
|
|
! END LOOP FOR THIS NODE
|
|
|
|
|
!
|
|
|
|
|
600 END DO
|
|
|
|
|
|
|
|
|
|
! do n=1,ne
|
|
|
|
|
! write(86,'(31i6)') n,(icon(n,j),j=1,ncmi)
|
|
|
|
|
! enddo
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
!
|
|
|
|
|
! PROCESS TO FIND NUMBER OF ACTIVE ELEMENTS
|
|
|
|
|
!
|
|
|
|
|
NAE=0
|
|
|
|
|
NTE=NE+1
|
|
|
|
|
DO 700 M=1,NE
|
|
|
|
|
IF (IMAT(M) .LT. 1) GO TO 650
|
|
|
|
|
NAE=NAE+1
|
|
|
|
|
MLIST(NAE)=M
|
|
|
|
|
GO TO 700
|
|
|
|
|
650 NTE=NTE-1
|
|
|
|
|
MLIST(NTE)=M
|
|
|
|
|
700 END DO
|
|
|
|
|
RETURN
|
|
|
|
|
END
|
|
|
|
|
|
|
|
|
|
!ipk jan01
|
|
|
|
|
subroutine getnlist(ipos)
|
|
|
|
|
use winteracter
|
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
include 'd.inc'
|
|
|
|
|
|
|
|
|
|
INTEGER :: IPOS,IERR
|
|
|
|
|
|
|
|
|
|
!
|
|
|
|
|
! Declare window-type and message variables
|
|
|
|
|
!
|
|
|
|
|
TYPE(WIN_STYLE) :: WINDOW
|
|
|
|
|
|
|
|
|
|
TYPE(WIN_MESSAGE) :: MESSAGE
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
call wdialogload(IDD_DIALOG001)
|
|
|
|
|
ierr=infoerror(1)
|
|
|
|
|
|
|
|
|
|
CALL WDialogSelect(IDD_DIALOG001)
|
|
|
|
|
ierr=infoerror(1)
|
|
|
|
|
|
|
|
|
|
CALL WDialogPutINTEGER(IDF_INTEGER1,IPOS)
|
|
|
|
|
|
|
|
|
|
! write(90,*) 'iposin',ipos
|
|
|
|
|
CALL WDialogShow(-1,-1,0,Modal)
|
|
|
|
|
ierr=infoerror(1)
|
|
|
|
|
|
|
|
|
|
do
|
|
|
|
|
IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
|
|
|
|
|
|
|
|
|
|
CALL WDialogGetINTEGER(IDF_INTEGER1,IPOS)
|
|
|
|
|
! write(90,*) 'iposout',ipos
|
|
|
|
|
|
|
|
|
|
return
|
|
|
|
|
endif
|
|
|
|
|
return
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
RETURN
|
|
|
|
|
END
|
|
|
|
|
|
|
|
|
|
!ipk jan04
|
|
|
|
|
subroutine SHOWORD
|
|
|
|
|
use winteracter
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
USE BLK1MOD
|
|
|
|
|
USE BLK2MOD
|
|
|
|
|
! INCLUDE 'BLK1.COM'
|
|
|
|
|
! INCLUDE 'BLK2.COM'
|
|
|
|
|
|
|
|
|
|
include 'd.inc'
|
|
|
|
|
|
|
|
|
|
INTEGER :: IERR
|
|
|
|
|
CHARACTER*6 SCOL1(101)
|
|
|
|
|
CHARACTER*18 SCOL2(101)
|
|
|
|
|
CHARACTER*8 SCOL3(101)
|
|
|
|
|
|
|
|
|
|
!
|
|
|
|
|
! Declare window-type and message variables
|
|
|
|
|
!
|
|
|
|
|
TYPE(WIN_STYLE) :: WINDOW
|
|
|
|
|
|
|
|
|
|
TYPE(WIN_MESSAGE) :: MESSAGE
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
call wdialogload(IDD_ORDEROUT)
|
|
|
|
|
ierr=infoerror(1)
|
|
|
|
|
|
|
|
|
|
CALL WDialogSelect(IDD_ORDEROUT)
|
|
|
|
|
ierr=infoerror(1)
|
|
|
|
|
DO I=0,NSEQ
|
|
|
|
|
WRITE(SCOL1(I+1),'(I4)') I
|
|
|
|
|
WRITE(SCOL2(I+1),'(I16)') MTSUMSV(I)
|
|
|
|
|
WRITE(SCOL3(I+1),'(I8)') NFWSV(I)
|
|
|
|
|
ENDDO
|
|
|
|
|
|
|
|
|
|
CALL WGridPutString(IDF_GRID1,1,SCOL1,NSEQ+1)
|
|
|
|
|
CALL WGridPutString(IDF_GRID1,2,SCOL2,NSEQ+1)
|
|
|
|
|
CALL WGridPutString(IDF_GRID1,3,SCOL3,NSEQ+1)
|
|
|
|
|
|
|
|
|
|
CALL WDialogShow(-1,-1,0,Modal)
|
|
|
|
|
ierr=infoerror(1)
|
|
|
|
|
|
|
|
|
|
do
|
|
|
|
|
IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
return
|
|
|
|
|
endif
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
RETURN
|
|
|
|
|
END
|
|
|
|
|
|
