iank
/
RMAGEN84
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
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.
master
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from 'b235079663'
${ noResults }
RMAGEN84/SRC84/GETNEWFIL.F90

785 lines
20 KiB
Fortran
Raw Normal View History Unescape Escape

VERSION84 WITH NEW GRID PLOTTING AND 1D EXPANSION
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
WRITE(90,*) 'INGETNEWFIL IFILOUT',IFILOUT
CALL WRTFIL(IFILOUT)
CALL ZEROOUT
IACTVFIL=ITOTFIL
ELSEIF(IACTVFIL .EQ. 0) THEN
IACTVFIL=1
ENDIF
IF(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)
ELSE
FNAMKEP='TEST.1.ELE'
ENDIF
IF(ABS(ITRIAN) .EQ. 1) THEN
CALL READGFG(IIN,ITRIAN)
! 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
IF(ITRIAN .EQ. -1) RETURN
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
CHARACTER*10 FMT
! INCLUDE 'BLK1.COM'
CLOSE (IFILOUT)
FMT(1:8)='TEMPFIL.'
WRITE(FMT(9:10),'(I2)') IFILOUT
! OPEN(IFILOUT,STATUS='scratch',FORM='binary')
WRITE(90,*) 'IFILOUT',IFILOUT
! OPEN(IFILOUT,STATUS='scratch',FORM='unformatted')
OPEN(IFILOUT,FILE=FMT,STATUS='UNKNOWN',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 WRTFIL', 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
WRITE(90,*) 'IPP',IPP
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'
INCLUDE 'TXFRM.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(ABS(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
IF(ISW .EQ. -1) THEN
NESV=NE
NPSV=NP
ENDIF
READ(IUNIT,*) NE,NCNTR,NATTR
IMIDS=0
NMESS=2
inattr=1
call GETINT(INATTR)
DO JJ=1,NE
READ(IUNIT,*) J,(NTMP(K),K=1,NCNTR),(ATT(K),K=1,NATTR)
IF(ISW .EQ. -1) J=J+NESV
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
IF(ISW .EQ. -1) THEN
NOP(J,2*KK-1) = NTMP(KK)+NPSV
ELSE
NOP(J,2*KK-1) = NTMP(KK)
ENDIF
NOP(J,2*KK)=0
ENDDO
IF(NATTR .GT. 0) THEN
IMAT(J)=ATT(1)
ELSE
IMAT(J)=INATTR
ENDIF
NCORN(J)=6
IESKP(J)=0
ENDDO
NE=J
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(ISW .EQ. -1) J=J+NPSV
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)
XUSR(J) = CX
YUSR(J) = CY
CORD(J,1) = (XUSR(J)+XS)/TXSCAL
CORD(J,2) = (YUSR(J)+YS)/TXSCAL
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