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.
758 lines
19 KiB
Fortran
758 lines
19 KiB
Fortran
5 years ago
|
SUBROUTINE GETNEWFIL(IIN,IGFG,ITRIAN,ISWT)
|
||
|
|
|
||
|
|
INCLUDE 'BFILES.I90'
|
||
|
|
|
||
|
|
! WRITE CURRENT DATA TO A SCRATCH FILE
|
||
|
|
|
||
|
|
IF(IACTVFIL .GT. 0 .AND. ISWT .NE. -1) THEN
|
||
|
|
IFILOUT=IACTVFIL+50
|
||
|
|
CALL WRTFIL(IFILOUT)
|
||
|
|
CALL ZEROOUT
|
||
|
|
IACTVFIL=ITOTFIL
|
||
|
|
ELSEIF(IACTVFIL .EQ. 0) THEN
|
||
|
|
IACTVFIL=1
|
||
|
|
ENDIF
|
||
|
|
IF(abs(ISWT) .EQ. 1) THEN
|
||
|
|
ITOTFIL=ITOTFIL+1
|
||
|
|
FNAMKEP='TEST.1.ELE'
|
||
|
|
IACTVFIL=ITOTFIL
|
||
|
|
FNAMEOUT(IACTVFIL)='TEST.1.ELE'
|
||
|
|
WRITE(90,*) 'ITOTFIL,IACTVFIL',ITOTFIL,IACTVFIL
|
||
|
|
WRITE(90,'(A80)') (FNAMEOUT(KKK),KKK=1,3)
|
||
|
|
ENDIF
|
||
|
|
IF(ITRIAN .EQ. 1) THEN
|
||
|
|
CALL READGFG(IIN,1)
|
||
|
|
|
||
|
|
! TEST FOR GFG FORMAT
|
||
|
|
ELSEIF(IGFG .EQ. 1) THEN
|
||
|
|
CALL READGFG(IIN,0)
|
||
|
|
|
||
|
|
! TEST FOR rm1 FORMAT
|
||
|
|
|
||
|
|
ELSEIF(IIN .EQ. 10) THEN
|
||
|
|
CALL READRM1(IIN)
|
||
|
|
|
||
|
|
! TEST FOR rm1 FORMAT
|
||
|
|
|
||
|
|
!ipk feb08 replace iin of 11 with 12
|
||
|
|
ELSEIF(IIN .EQ. 12 .and. IGFG .EQ. 0) THEN
|
||
|
|
CALL READGEO(IIN)
|
||
|
|
|
||
|
|
ELSEIF(IIN .EQ. 12 .and. IGFG .EQ. 2) THEN
|
||
|
|
CALL RDBIN(IIN)
|
||
|
|
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
IFILOUT=IACTVFIL+50
|
||
|
|
WRITE(90,*) 'IFILOUT', IFILOUT
|
||
|
|
CALL WRTFIL(IFILOUT)
|
||
|
|
IACTVFIL=1
|
||
|
|
CALL LOADFIL
|
||
|
|
|
||
|
|
|
||
|
|
CALL RESCAL
|
||
|
|
CALL HEDR
|
||
|
|
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
! Write data to a file
|
||
|
|
SUBROUTINE WRTFIL(IFILOUT)
|
||
|
|
|
||
|
|
USE BLK1MOD
|
||
|
|
CHARACTER*80 ALINE
|
||
|
|
! INCLUDE 'BLK1.COM'
|
||
|
|
|
||
|
|
CLOSE (IFILOUT)
|
||
|
|
OPEN(IFILOUT,STATUS='scratch',FORM='binary')
|
||
|
|
|
||
|
|
ISLP=0
|
||
|
|
IPRT=1
|
||
|
|
IPNN=1
|
||
|
|
IPEN=1
|
||
|
|
IPO=1
|
||
|
|
IRO=1
|
||
|
|
IPP=0
|
||
|
|
IRFN=0
|
||
|
|
IGEN=0
|
||
|
|
NXZL=0
|
||
|
|
NITST=1
|
||
|
|
ISCTXT=0
|
||
|
|
IFILL=0
|
||
|
|
IALTGM=1
|
||
|
|
NLAYD=0
|
||
|
|
HORIZ=10.
|
||
|
|
VERT=8.
|
||
|
|
XSALE=0.
|
||
|
|
YSALE=0.
|
||
|
|
XFACT=0.
|
||
|
|
YFACT=0.
|
||
|
|
AR=0.
|
||
|
|
ANG=0.
|
||
|
|
xadded=0.
|
||
|
|
yadded=0.
|
||
|
|
ntempin=0.
|
||
|
|
! WRITE(90,*) 'IN GETNEWFIL', IFILOUT,NP,NE,IPRT
|
||
|
|
WRITE(IFILOUT) TITLE,NP,NE
|
||
|
|
WRITE(IFILOUT) ISLP,IPRT,IPNN,IPEN,IPO,IRO,IPP,IRFN &
|
||
|
|
& ,IGEN,NXZL,NITST,ISCTXT,IFILL,IALTGM,NLAYD,xadded,yadded,ntempin
|
||
|
|
! WRITE(90,*) ISLP,IPRT,IPNN,IPEN,IPO,IRO,IPP,IRFN &
|
||
|
|
! & ,IGEN,NXZL,NITST,ISCTXT,IFILL,IALTGM,NLAYD,xadded,yadded,ntempin
|
||
|
|
WRITE(IFILOUT) HORIZ,VERT,XSALE,YSALE,XFACT,YFACT,AR,ANG
|
||
|
|
IF(IPP .GT. 0) WRITE(IFILOUT) ALINE
|
||
|
|
|
||
|
|
WRITE(IFILOUT) ((NOP(J,K),K=1,8),IMAT(J),THTA(J),J=1,NE)
|
||
|
|
WRITE(IFILOUT) &
|
||
|
|
(XUSR(J),YUSR(J),WD(J),WIDTH(J),SS1(J),SS2(J),WIDS(J), &
|
||
|
|
& WIDBS(J),SSO(J),BS1(J),J=1,NP)
|
||
|
|
|
||
|
|
WRITE(IFILOUT) NLST
|
||
|
|
IF(NLST .GT. 0) THEN
|
||
|
|
WRITE(IFILOUT) (LLIST(J),J=1,NLST), &
|
||
|
|
& ((ILIST(J,I),I=1,LLIST(J)),J=1,NLST)
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
WRITE(IFILOUT) NENTRY,NLAYD,NCLM
|
||
|
|
|
||
|
|
IF(NENTRY .GT. 0) THEN
|
||
|
|
WRITE(IFILOUT) ((NEF(I,J),J=1,3),I=1,NENTRY)
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
IF(NLAYD .GT. 0) THEN
|
||
|
|
WRITE(IFILOUT) (LAY(I),I=1,NP)
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
IF(NCLM .GT. 0) THEN
|
||
|
|
WRITE(IFILOUT) ((ICCLN(I,J),J=1,350),I=1,NCLM)
|
||
|
|
ENDIF
|
||
|
|
REWIND IFILOUT
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
SUBROUTINE READRM1(IIIN)
|
||
|
|
|
||
|
|
USE BLK1MOD
|
||
|
|
! INCLUDE 'BLK1.COM'
|
||
|
|
CHARACTER*48 DLIN
|
||
|
|
|
||
|
|
IIN=IIIN
|
||
|
|
! Read in header lines
|
||
|
|
|
||
|
|
ISET=1
|
||
|
|
WRITE(90,*) 'GOING TO HEADIN'
|
||
|
|
CALL HEADIN(IIN,ISET)
|
||
|
|
|
||
|
|
! Read in existing elements
|
||
|
|
WRITE(90,*) 'GOING TO RDELEM'
|
||
|
|
CALL RDELEM(IIN)
|
||
|
|
|
||
|
|
! Read in nodal coordinates
|
||
|
|
|
||
|
|
WRITE(90,*) 'GOING TO RDCORD'
|
||
|
|
CALL RDCORD(IIN)
|
||
|
|
|
||
|
|
! Close input file
|
||
|
|
|
||
|
|
CLOSE(IIN)
|
||
|
|
|
||
|
|
! Scale for plotting
|
||
|
|
|
||
|
|
IF(NP .GT. 0) THEN
|
||
|
|
DO J=1,NP
|
||
|
|
IF (CORD(J,1) .GT. VDX) THEN
|
||
|
|
XMIN=MIN(XMIN,CORD(J,1))
|
||
|
|
XMAX=MAX(XMAX,CORD(J,1))
|
||
|
|
YMIN=MIN(YMIN,CORD(J,2))
|
||
|
|
YMAX=MAX(YMAX,CORD(J,2))
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
! Read GEO file
|
||
|
|
SUBROUTINE READGEO(IIIN)
|
||
|
|
USE BLK1MOD
|
||
|
|
CHARACTER*1000 HEADER
|
||
|
|
CHARACTER*8 ID8
|
||
|
|
CHARACTER*32 IJNK
|
||
|
|
CHARACTER*80 ALINE,DLIN
|
||
|
|
! INCLUDE 'BLK1.COM'
|
||
|
|
INCLUDE 'BFILES.I90'
|
||
|
|
|
||
|
|
INTEGER*2 NOP2(MAXE,8)
|
||
|
|
|
||
|
|
|
||
|
|
IIN=IIIN
|
||
|
|
read(iin,err=100) header
|
||
|
|
if(header(1:6) .eq. 'RMAGEN') then
|
||
|
|
inopt=2
|
||
|
|
else
|
||
|
|
inopt=1
|
||
|
|
rewind iin
|
||
|
|
endif
|
||
|
|
read(iin) n1,m1
|
||
|
|
rewind iin
|
||
|
|
write(90,*) 'Apparent nodes and elements from file are'
|
||
|
|
write(90,'(i15,i10)') n1,m1
|
||
|
|
if(n1 .gt. maxp .or. m1 .gt. maxe) then
|
||
|
|
!
|
||
|
|
!...... Perhaps the file format is wrong, close and reopen
|
||
|
|
!
|
||
|
|
WRITE(DLIN,'(A32)') 'Parameter limits may be violated'
|
||
|
|
call symbl(0.5,4.5,0.20,dlin,0.0,32)
|
||
|
|
WRITE(DLIN,'(A35)') 'Retrying with alternate file format'
|
||
|
|
call symbl(0.5,4.2,0.20,dlin,0.0,35)
|
||
|
|
close (iin)
|
||
|
|
open(iin ,file=fnamkep,status='old',form='unformatted')
|
||
|
|
read(iin) n1,m1
|
||
|
|
write(90,*) 'Revised nodes and elements from file are'
|
||
|
|
write(90,'(i15,i10)') n1,m1
|
||
|
|
if(n1 .gt. maxp .or. m1 .gt. maxe) then
|
||
|
|
WRITE(DLIN,'(A31)') 'Parameter limits still violated'
|
||
|
|
call symbl(0.5,3.9,0.20,dlin,0.0,31)
|
||
|
|
WRITE(DLIN,'(A27)') 'Apparent nodes and elts are'
|
||
|
|
call symbl(0.5,3.6,0.20,dlin,0.0,27)
|
||
|
|
WRITE(DLIN,'(2i10)') n1,m1
|
||
|
|
call symbl(0.5,3.3,0.20,dlin,0.0,20)
|
||
|
|
WRITE(DLIN,'(A24)') 'Press enter to terminate'
|
||
|
|
call symbl(0.5,4.5,0.20,dlin,0.0,24)
|
||
|
|
CALL GTCHARX(ijnk,ndig,5.0,4.0)
|
||
|
|
!cipk aug00 read(*,'(i1)') junk
|
||
|
|
call quit_pgm
|
||
|
|
endif
|
||
|
|
endif
|
||
|
|
rewind iin
|
||
|
|
!
|
||
|
|
!
|
||
|
|
if(inopt .eq. 2) then
|
||
|
|
read(iin,err=100) header
|
||
|
|
READ(IIN,ERR=100) &
|
||
|
|
& N1,M1,((CORD(J,K),K=1,2),ALPHA,WD(J),J=1,N1), &
|
||
|
|
& ((NOP(J,K),K=1,8),IMAT(J),THTA(J),I3,J=1,M1) &
|
||
|
|
& , (WIDTH(J),SS1(J),SS2(J),WIDS(J),J=1,N1)
|
||
|
|
DO J=1,N1
|
||
|
|
XUSR(J)=CORD(J,1)
|
||
|
|
YUSR(J)=CORD(J,2)
|
||
|
|
ENDDO
|
||
|
|
!
|
||
|
|
else
|
||
|
|
READ(IIN,ERR=100) &
|
||
|
|
& N1,M1,((CORDSN(J,K),K=1,2),ALPHA,WD(J),J=1,N1), &
|
||
|
|
& ((NOP2(J,K),K=1,8),IMAT(J),THTA(J),I32,J=1,M1) &
|
||
|
|
& , (WIDTH(J),SS1(J),SS2(J),WIDS(J),J=1,N1)
|
||
|
|
DO J=1,N1
|
||
|
|
DO K=1,2
|
||
|
|
CORD(J,K)=CORDSN(J,K)
|
||
|
|
ENDDO
|
||
|
|
XUSR(J)=CORD(J,1)
|
||
|
|
YUSR(J)=CORD(J,2)
|
||
|
|
ENDDO
|
||
|
|
DO J=1,M1
|
||
|
|
!ipk feb08
|
||
|
|
ncorn(j)=0
|
||
|
|
DO K=1,8
|
||
|
|
NOP(J,K)=NOP2(J,K)
|
||
|
|
!ipk feb08
|
||
|
|
if(nop(j,k) .gt. 0) ncorn(j)=k
|
||
|
|
ENDDO
|
||
|
|
ENDDO
|
||
|
|
endif
|
||
|
|
read(IIN,err=120,end=120) id8
|
||
|
|
if(id8(1:6) .eq. 'part-2') then
|
||
|
|
read(IIN,err=104) (widbs(j),sso(j),j=1,n1)
|
||
|
|
read(IIN,err=120,end=120) id8
|
||
|
|
endif
|
||
|
|
|
||
|
|
! Add part 3 write for continuity lines
|
||
|
|
if(id8(1:6) .eq. 'part-3') then
|
||
|
|
|
||
|
|
!ipk aug02 IF(NCLM .GT. 0) THEN
|
||
|
|
READ(IIN,ERR=104) NCLM,((ICCLN(I,J),J=1,350),I=1,NCLM)
|
||
|
|
!ipk aug02 ENDIF
|
||
|
|
read(IIN,err=120,end=120) id8
|
||
|
|
endif
|
||
|
|
!IPK DEB02 Add part 4 write for lock and BS1 lines and reordering
|
||
|
|
if(id8(1:6) .eq. 'part-4') then
|
||
|
|
read(iin,err=104,end=120) (lock(j),bs1(j),j=1,n1)
|
||
|
|
read(iin,err=104,end=120) &
|
||
|
|
nlst,((ilist(j,k),k=1,maeln),llist(j),j=1,maxln)
|
||
|
|
endif
|
||
|
|
DO J=1,M1
|
||
|
|
!ipk feb08
|
||
|
|
ncorn(j)=0
|
||
|
|
DO K=1,8
|
||
|
|
!ipk feb08
|
||
|
|
if(nop(j,k) .gt. 0) ncorn(j)=k
|
||
|
|
ENDDO
|
||
|
|
ENDDO
|
||
|
|
|
||
|
|
GO TO 120
|
||
|
|
|
||
|
|
100 READ(IIN,ERR=104) &
|
||
|
|
& N1,M1,((CORDSN(J,K),K=1,2),ALPHA,WD(J),J=1,N1), &
|
||
|
|
& ((NOP2(J,K),K=1,8),IMAT(J),THTA(J),I32,J=1,M1)
|
||
|
|
DO J=1,N1
|
||
|
|
DO K=1,2
|
||
|
|
CORD(J,K)=CORDSN(J,K)
|
||
|
|
ENDDO
|
||
|
|
XUSR(J)=CORD(J,1)
|
||
|
|
YUSR(J)=CORD(J,2)
|
||
|
|
ENDDO
|
||
|
|
DO J=1,M1
|
||
|
|
!ipk feb08
|
||
|
|
ncorn(j)=0
|
||
|
|
DO K=1,8
|
||
|
|
NOP(J,K)=NOP2(J,K)
|
||
|
|
!ipk feb08
|
||
|
|
if(nop(j,k) .gt. 0) ncorn(j)=k
|
||
|
|
ENDDO
|
||
|
|
ENDDO
|
||
|
|
GO TO 120
|
||
|
|
|
||
|
|
104 WRITE(90,*) 'Error reading binary geometry file'
|
||
|
|
!ipk jan98 CALL SETD(23)
|
||
|
|
call clscrn()
|
||
|
|
WRITE(aline,*) 'Error reading binary geometry file'
|
||
|
|
call symbl &
|
||
|
|
& (1.1,3.3,0.20,aline,0.0,80)
|
||
|
|
WRITE(aline,*) 'Press enter to exit'
|
||
|
|
call symbl &
|
||
|
|
& (1.1,3.0,0.20,aline,0.0,80)
|
||
|
|
ndig=1
|
||
|
|
CALL GTCHARX(IJNK,NDIG,5.0,7.6)
|
||
|
|
CALL Quit_Pgm
|
||
|
|
STOP
|
||
|
|
|
||
|
|
120 CONTINUE
|
||
|
|
NP=N1
|
||
|
|
NE=M1
|
||
|
|
|
||
|
|
! Close input file
|
||
|
|
|
||
|
|
CLOSE(IIN)
|
||
|
|
|
||
|
|
! Scale for plotting
|
||
|
|
|
||
|
|
IF(NP .GT. 0) THEN
|
||
|
|
DO J=1,NP
|
||
|
|
IF (CORD(J,1) .GT. VDX) THEN
|
||
|
|
XMIN=MIN(XMIN,CORD(J,1))
|
||
|
|
XMAX=MAX(XMAX,CORD(J,1))
|
||
|
|
YMIN=MIN(YMIN,CORD(J,2))
|
||
|
|
YMAX=MAX(YMAX,CORD(J,2))
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
ENDIF
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
END
|
||
|
|
|
||
|
|
SUBROUTINE READGFG(IUNIT,ISW)
|
||
|
|
|
||
|
|
USE BLK1MOD
|
||
|
|
INCLUDE "BFILES.I90"
|
||
|
|
! INCLUDE 'BLK1.COM'
|
||
|
|
CHARACTER*1 ANS
|
||
|
|
CHARACTER*32 ANS32
|
||
|
|
CHARACTER*3 ID
|
||
|
|
CHARACTER*77 DLIN
|
||
|
|
CHARACTER*150 DLIN1
|
||
|
|
CHARACTER*80 LIND
|
||
|
|
DIMENSION NTMP(9),NTEMPLIN(200,10),ATT(9)
|
||
|
|
|
||
|
|
REAL*8 CX,CY,VALS(7)
|
||
|
|
|
||
|
|
MEL=MAXE
|
||
|
|
ylv=7.5
|
||
|
|
IIN=IUNIT
|
||
|
|
IPRT=1
|
||
|
|
IPNN=1
|
||
|
|
IPEN=1
|
||
|
|
IPO=1
|
||
|
|
IRO=1
|
||
|
|
IPP=0
|
||
|
|
IRFN=0
|
||
|
|
IGEN=0
|
||
|
|
NXZL=0
|
||
|
|
NITST=1
|
||
|
|
ISCTXT=0
|
||
|
|
IFILL=0
|
||
|
|
IALTGM=1
|
||
|
|
NLAYD=0
|
||
|
|
HORIZ=10.
|
||
|
|
VERT=8.
|
||
|
|
XSALE=0.
|
||
|
|
YSALE=0.
|
||
|
|
XFACT=0.
|
||
|
|
YFACT=0.
|
||
|
|
AR=0.
|
||
|
|
ANG=0.
|
||
|
|
xadded=0.
|
||
|
|
yadded=0.
|
||
|
|
ntempin=0.
|
||
|
|
KLIN=0
|
||
|
|
IF(ISW .EQ. 1) GO TO 500
|
||
|
|
DO I=1,10000
|
||
|
|
READ(IIN,'(A3,A77)') ID,DLIN
|
||
|
|
IF(ID .EQ. 'T1 ') THEN
|
||
|
|
TITLE(1:77)=DLIN
|
||
|
|
GO TO 10
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
10 CONTINUE
|
||
|
|
REWIND IIN
|
||
|
|
|
||
|
|
! READ ELEMENT AND CCLINE DATA
|
||
|
|
|
||
|
|
20 CONTINUE
|
||
|
|
DO ICOUNTC=1,200000
|
||
|
|
DO JJ=1,150
|
||
|
|
DLIN1(JJ:JJ)=' '
|
||
|
|
ENDDO
|
||
|
|
READ(IIN,'(A3,A150)', END=175) ID,DLIN1
|
||
|
|
IF(ID .EQ. 'GE ' .or. ID .EQ. 'GO') THEN
|
||
|
|
! Count the number of variables
|
||
|
|
I=0
|
||
|
|
ICOUNT=0
|
||
|
|
25 CONTINUE
|
||
|
|
IF(DLIN1(I+1:I+1) .NE. ' ') THEN
|
||
|
|
GO TO 30
|
||
|
|
ELSE
|
||
|
|
I=I+1
|
||
|
|
GO TO 25
|
||
|
|
ENDIF
|
||
|
|
30 I=I+1
|
||
|
|
IF(I .EQ. 151) THEN
|
||
|
|
ICOUNT =ICOUNT+1
|
||
|
|
GO TO 40
|
||
|
|
ENDIF
|
||
|
|
IF(DLIN1(I:I) .EQ. ' ' .OR. DLIN1(I:I) .EQ. ',') THEN
|
||
|
|
ICOUNT=ICOUNT+1
|
||
|
|
35 CONTINUE
|
||
|
|
IF(I+1 .EQ. 151) GO TO 40
|
||
|
|
IF(DLIN1(I+1:I+1) .EQ. ' ') THEN
|
||
|
|
I=I+1
|
||
|
|
GO TO 35
|
||
|
|
ELSE
|
||
|
|
GO TO 30
|
||
|
|
ENDIF
|
||
|
|
ELSE
|
||
|
|
GO TO 30
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
40 CONTINUE
|
||
|
|
IF(ID .EQ. 'GO') THEN
|
||
|
|
KLIN=KLIN+1
|
||
|
|
READ(DLIN1,*) (NTEMPLIN(KLIN,K),K=1,ICOUNT)
|
||
|
|
GO TO 20
|
||
|
|
ENDIF
|
||
|
|
IF(ICOUNT .GT. 10) THEN
|
||
|
|
READ(DLIN1,*) J, (NTMP(K),K=1,9),THT
|
||
|
|
ELSE
|
||
|
|
READ(DLIN1,*) J, (NTMP(K),K=1,9)
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
|
||
|
|
IF (J .GE. MEL) THEN
|
||
|
|
CALL SETD(23)
|
||
|
|
!cipk aug00
|
||
|
|
WRITE(lind,*) ' Element number exceeds MAXE in RDELEM'
|
||
|
|
call symbl (1.1,ylv-0.3,0.20,lind,0.0,80)
|
||
|
|
ndig=1
|
||
|
|
WRITE(90,*) ' Element number exceeds MAXE in RDELEM'
|
||
|
|
WRITE(lind,6000)
|
||
|
|
CALL GTCHARX(ANS32,IJNK,5.0,4.0)
|
||
|
|
CALL Quit_Pgm
|
||
|
|
STOP
|
||
|
|
ENDIF
|
||
|
|
!
|
||
|
|
! Check to ensure there are no duplicate numbers in input stream
|
||
|
|
! of element connections
|
||
|
|
!
|
||
|
|
DO K=1,7
|
||
|
|
IF(NTMP(K) .NE. 0) THEN
|
||
|
|
DO L=K+1,8
|
||
|
|
IF(NTMP(K) .EQ. NTMP(L)) THEN
|
||
|
|
CALL SETD(23)
|
||
|
|
DO KK=1,8
|
||
|
|
NOP(J,KK) = NTMP(KK)
|
||
|
|
ENDDO
|
||
|
|
IMAT(J)=NTMP(9)
|
||
|
|
call eltdisp(j)
|
||
|
|
DO KK=1,8
|
||
|
|
NTMP(KK) = NOP(J,KK)
|
||
|
|
ENDDO
|
||
|
|
NTMP(9)=IMAT(J)
|
||
|
|
GO TO 45
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
45 CONTINUE
|
||
|
|
DO K=1,8
|
||
|
|
NOP(J,K) = NTMP(K)
|
||
|
|
ND = NTMP(K)
|
||
|
|
IF (ND .GT. 0) THEN
|
||
|
|
INEW(ND) = 2
|
||
|
|
NP = MAX(NP,ND)
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
!
|
||
|
|
NCN = 2
|
||
|
|
IF (NOP(J,3) .NE. 0) NCN = 3
|
||
|
|
IF (NOP(J,4) .NE. 0) NCN = 4
|
||
|
|
IF (NOP(J,5) .NE. 0 .AND. NOP(J,4) .NE. 0) NCN = 5
|
||
|
|
IF (NOP(J,5) .NE. 0 .AND. NOP(J,4) .EQ. 0) NCN = 6
|
||
|
|
IF (NOP(J,6) .NE. 0) NCN = 6
|
||
|
|
IF (NOP(J,7) .NE. 0) NCN = 8
|
||
|
|
NCORN(J) = NCN
|
||
|
|
IESKP(J) = 0
|
||
|
|
IMAT(J) = NTMP(9)
|
||
|
|
THTA(J)=THT
|
||
|
|
IEM(J) = J
|
||
|
|
DO 50 K=2,NCN,2
|
||
|
|
ND = NTMP(K)
|
||
|
|
IF (ND .GT. 0) THEN
|
||
|
|
IF(NCN .EQ. 5 .AND. K .EQ. 4) GO TO 50
|
||
|
|
WD(ND)=0.
|
||
|
|
ENDIF
|
||
|
|
50 CONTINUE
|
||
|
|
NE = MAX(J,NE)
|
||
|
|
!
|
||
|
|
GOTO 20
|
||
|
|
!
|
||
|
|
175 CONTINUE
|
||
|
|
|
||
|
|
REWIND IIN
|
||
|
|
70 CONTINUE
|
||
|
|
DO ICOUNTC=1,100000
|
||
|
|
DO JJ=1,150
|
||
|
|
DLIN1(JJ:JJ)=' '
|
||
|
|
ENDDO
|
||
|
|
READ(IIN,'(A3,A150)', END=400) ID,DLIN1
|
||
|
|
IF(ID .EQ. 'GNN' .OR. ID .EQ. 'GWN') THEN
|
||
|
|
! Count the number of variables
|
||
|
|
I=0
|
||
|
|
ICOUNT=0
|
||
|
|
75 CONTINUE
|
||
|
|
IF(DLIN1(I+1:I+1) .NE. ' ') THEN
|
||
|
|
GO TO 80
|
||
|
|
ELSE
|
||
|
|
I=I+1
|
||
|
|
GO TO 75
|
||
|
|
ENDIF
|
||
|
|
80 I=I+1
|
||
|
|
IF(I .EQ. 151) THEN
|
||
|
|
ICOUNT =ICOUNT+1
|
||
|
|
GO TO 90
|
||
|
|
ENDIF
|
||
|
|
IF(DLIN1(I:I) .EQ. ' ' .OR. DLIN1(I:I) .EQ. ',') THEN
|
||
|
|
ICOUNT=ICOUNT+1
|
||
|
|
85 CONTINUE
|
||
|
|
IF(I+1 .EQ. 151) GO TO 90
|
||
|
|
IF(DLIN1(I+1:I+1) .EQ. ' ') THEN
|
||
|
|
I=I+1
|
||
|
|
GO TO 85
|
||
|
|
ELSE
|
||
|
|
GO TO 80
|
||
|
|
ENDIF
|
||
|
|
ELSE
|
||
|
|
GO TO 80
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
90 CONTINUE
|
||
|
|
DO K=1,7
|
||
|
|
VALS(K)=0.
|
||
|
|
ENDDO
|
||
|
|
READ(DLIN1,*) J,(VALS(K),K=1,ICOUNT-1)
|
||
|
|
IF(ID .EQ. 'GNN') THEN
|
||
|
|
CX=VALS(1)
|
||
|
|
CY=VALS(2)
|
||
|
|
BELEV=VALS(3)
|
||
|
|
NP = MAX(NP,J)
|
||
|
|
CORD(J,1) = CX
|
||
|
|
CORD(J,2) = CY
|
||
|
|
XUSR(J) = CX
|
||
|
|
YUSR(J) = CY
|
||
|
|
WD(J) = BELEV
|
||
|
|
INSKP(J)=0
|
||
|
|
INEW(J) = 1
|
||
|
|
GO TO 70
|
||
|
|
ELSE
|
||
|
|
WDTHX=VALS(1)
|
||
|
|
SS1X=VALS(2)
|
||
|
|
SS2X=VALS(3)
|
||
|
|
WDSX=VALS(4)
|
||
|
|
WIDTH(J)=WDTHX
|
||
|
|
SS1(J)=SS1X
|
||
|
|
SS2(J)=SS2X
|
||
|
|
WIDS(J)=WDSX
|
||
|
|
GO TO 70
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
400 CONTINUE
|
||
|
|
|
||
|
|
! CHECKOUT THE CCLINE DATA
|
||
|
|
|
||
|
|
KK=0
|
||
|
|
IF(KLIN .GT. 0) THEN
|
||
|
|
NCLM=1
|
||
|
|
IF(NTEMPLIN(1,1) .EQ. 1) THEN
|
||
|
|
DO K=1,KLIN
|
||
|
|
DO J=1,10
|
||
|
|
IF(K .EQ. 1 .AND. J .EQ. 1) GO TO 410
|
||
|
|
IF(NTEMPLIN(K,J) .LT. 0) THEN
|
||
|
|
NCLM=NCLM+1
|
||
|
|
KK=0
|
||
|
|
GO TO 420
|
||
|
|
ELSEIF(NTEMPLIN(K,J) .EQ. 0) THEN
|
||
|
|
GO TO 420
|
||
|
|
ELSE
|
||
|
|
KK=KK+1
|
||
|
|
ICCLN(NCLM,KK)=NTEMPLIN(K,J)
|
||
|
|
ENDIF
|
||
|
|
410 CONTINUE
|
||
|
|
ENDDO
|
||
|
|
420 CONTINUE
|
||
|
|
ENDDO
|
||
|
|
NCLM=NCLM-1
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
500 CONTINUE
|
||
|
|
|
||
|
|
READ(IUNIT,*) NE,NCNTR,NATTR
|
||
|
|
IMIDS=0
|
||
|
|
DO JJ=1,NE
|
||
|
|
READ(IUNIT,*) J,(NTMP(K),K=1,NCNTR),(ATT(K),K=1,NATTR)
|
||
|
|
IF (J .GE. MEL) THEN
|
||
|
|
CALL SETD(23)
|
||
|
|
WRITE(lind,*) ' Element number exceeds MAXE in RDELEM'
|
||
|
|
call symbl &
|
||
|
|
& (1.1,ylv-0.3,0.20,lind,0.0,80)
|
||
|
|
ndig=1
|
||
|
|
WRITE(90,*) ' Element number exceeds MAXE in RDELEM'
|
||
|
|
WRITE(lind,6000)
|
||
|
|
CALL GTCHARX(ANS32,IJNK,5.0,4.0)
|
||
|
|
CALL Quit_Pgm
|
||
|
|
STOP
|
||
|
|
ENDIF
|
||
|
|
DO KK=1,3
|
||
|
|
NOP(J,2*KK-1) = NTMP(KK)
|
||
|
|
NOP(J,2*KK)=0
|
||
|
|
ENDDO
|
||
|
|
IF(NATTR .GT. 0) THEN
|
||
|
|
IMAT(J)=ATT(1)
|
||
|
|
ELSE
|
||
|
|
IMAT(J)=1
|
||
|
|
ENDIF
|
||
|
|
NCORN(J)=6
|
||
|
|
IESKP(J)=0
|
||
|
|
ENDDO
|
||
|
|
CLOSE(IUNIT)
|
||
|
|
DO L=255,1,-1
|
||
|
|
IF(FNAMKEP(L:L) .EQ. '.') THEN
|
||
|
|
FNAMKEP(L+1:L+4)='node'
|
||
|
|
OPEN(IUNIT,FILE=FNAMKEP,STATUS='OLD',ACTION='READ')
|
||
|
|
GO TO 510
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
510 CONTINUE
|
||
|
|
|
||
|
|
READ(IUNIT,*) NPPP,NDUM,NATTR
|
||
|
|
DO KK=1,NPPP
|
||
|
|
READ(IUNIT,*) J,CX,CY,(VALS(K),K=1,NATTR)
|
||
|
|
IF(J .EQ. 0) THEN
|
||
|
|
J=NPPP
|
||
|
|
JZ=1
|
||
|
|
ENDIF
|
||
|
|
BELEV=-9999.
|
||
|
|
WEL=0.
|
||
|
|
LOCK1=0
|
||
|
|
IF(NATTR .GT. 0) BELEV=VALS(1)
|
||
|
|
IF (J .GE. MAXP) THEN
|
||
|
|
call clscrn()
|
||
|
|
WRITE(dlin,*) ' Node number exceeds MAXP in RDCORD',j
|
||
|
|
call symbl &
|
||
|
|
& (1.1,3.3,0.20,dlin,0.0,80)
|
||
|
|
WRITE(90,*) ' Node number exceeds MAXP in RDCORD'
|
||
|
|
WRITE(DLIN,*) ' Press enter to exit'
|
||
|
|
call symbl &
|
||
|
|
& (1.1,3.0,0.20,dlin,0.0,80)
|
||
|
|
ndig=1
|
||
|
|
CALL GTCHARX(ANS32,ndig,5.0,4.0)
|
||
|
|
CALL Quit_Pgm
|
||
|
|
STOP
|
||
|
|
ENDIF
|
||
|
|
NP = MAX(NP,J)
|
||
|
|
CORD(J,1) = CX
|
||
|
|
CORD(J,2) = CY
|
||
|
|
XUSR(J) = CX
|
||
|
|
YUSR(J) = CY
|
||
|
|
WD(J) = BELEV
|
||
|
|
WIDTH(J)=0.
|
||
|
|
SS1(J)=0.
|
||
|
|
SS2(J)=0.
|
||
|
|
WIDS(J)=0.
|
||
|
|
WIDBS(J)=0.
|
||
|
|
SSO(J)=0.
|
||
|
|
INSKP(J)=0
|
||
|
|
INEW(J) = 1
|
||
|
|
LOCK(J)=LOCK1
|
||
|
|
BS1(J)=0.
|
||
|
|
ENDDO
|
||
|
|
|
||
|
|
CLOSE(IUNIT)
|
||
|
|
6000 FORMAT(' Press enter to exit')
|
||
|
|
END
|
||
|
|
|
||
|
|
|
||
|
|
SUBROUTINE ZEROOUT
|
||
|
|
|
||
|
|
USE BLK1MOD
|
||
|
|
! INCLUDE 'BLK1.COM'
|
||
|
|
|
||
|
|
MNP = MAXP
|
||
|
|
MEL = MAXE
|
||
|
|
DO I=1,MEL
|
||
|
|
DO M=1,8
|
||
|
|
NOP(I,M)=0
|
||
|
|
ENDDO
|
||
|
|
IESKP(I)=-1
|
||
|
|
IEM(I) = 0
|
||
|
|
IMAT(I) = 0
|
||
|
|
THTA(I)=0.
|
||
|
|
XC(I) = -1.E20
|
||
|
|
YC(I) = -1.E20
|
||
|
|
ENDDO
|
||
|
|
DO I=1,MNP
|
||
|
|
XUSR(I) = -1.D20
|
||
|
|
YUSR(I) = -1.D20
|
||
|
|
CORD(I,1) = -1.D20
|
||
|
|
CORD(I,2) = -1.D20
|
||
|
|
WD(I) = -9999.
|
||
|
|
LAY(I) = -9999
|
||
|
|
WIDTH(I) = 0.0
|
||
|
|
SS1(I) = 0.0
|
||
|
|
SS2(I) = 0.0
|
||
|
|
WIDS(I) = 0.0
|
||
|
|
WIDBS(I)=0.
|
||
|
|
SSO(I)=0.
|
||
|
|
INSKP(I) = 1
|
||
|
|
INEW(I) = 0
|
||
|
|
!ipk mar02
|
||
|
|
lock(i)=0
|
||
|
|
bs1(I)=0.
|
||
|
|
ENDDO
|
||
|
|
NP=0
|
||
|
|
NE=0
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|