program ina1a
c.....12-30-94: added permeability modifiers
c program ina1
c.....8-3-93: modification: use a specified y-interval
c.....5-18-93: read ELEME block of a MESH file; place all elements in
c specified z-interval in "inactive" position
PARAMETER(MNEL=45000,MNCON=45000,MNEQ=3,MNK=2,MNPH=2,MNB=6)
COMMON/MADIM/M1,M2,M3,M4,M5,M6,M7,M8
C
C=======================================================================
C
C
C$$$$$$$$$ COMMON BLOCKS FOR ELEMENTS $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
C
C THESE BLOCKS HAVE A LENGTH OF NEL (= NUMBER OF ELEMENTS)
C
COMMON/E1/ELEM(2*MNEL)
COMMON/E2/MATX(2*MNEL)
COMMON/E3/EVOL(2*MNEL)
COMMON/AHTRAN/AHT(2*MNEL)
common/pemo/pm(2*mnel)
common/xyz/x(2*mnel),y(2*mnel),z(2*mnel)
C
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
C
C
CHARACTER*5 ELEM,MATX,dom1,domx
C
LOGICAL EX
C
SAVE ICALL
DATA ICALL/0/
ICALL=ICALL+1
C
IF(ICALL.EQ.1) print 899
899 FORMAT(6X,'INA1A 0.9 30 December 1994',6X,'READ',
c 899 FORMAT(6X,'INA1A 0.9 3 August 1993',6X,'READ',
X' AN ELEMENT DATA BLOCK FROM A MESH FILE'/
X6X,'place elements outside a specific y-interval in',
x' inactive position')
c 899 FORMAT(6X,'INA1 0.9 18 May 1993',6X,'READ',
c X' AN ELEMENT DATA BLOCK FROM A MESH FILE'/
c X6X,'place elements from a specific z-interval in inactive',
c x' position')
C
M1=MNEL
M2=MNCON
M3=MNEQ
M4=MNPH
M5=MNB+MNK
M6=MNOGN
M7=MGTAB
M8=MNK
c
INQUIRE(FILE='MESH',EXIST=EX)
IF(EX) GOTO 2
PRINT 3
3 FORMAT(' FILE *MESH* DOES NOT EXIST --- STOP EXECUTION')
STOP
c
2 PRINT 4
4 FORMAT(' FILE *MESH* EXISTS --- OPEN AS AN OLD FILE')
OPEN(4,FILE='MESH',STATUS='OLD')
C
INQUIRE(FILE='MINC',EXIST=EX)
IF(EX) GOTO 112
PRINT 113
113 FORMAT(' FILE *MINC* DOES NOT EXIST --- OPEN AS A NEW FILE')
OPEN(10,FILE='MINC',STATUS='NEW')
GOTO 120
C
112 PRINT 114
114 FORMAT(' FILE *MINC* EXISTS --- OPEN AS AN OLD FILE')
OPEN(10,FILE='MINC',STATUS='OLD')
C
120 CONTINUE
C
print 115
115 format(' enter lower, upper bound as: yl,0 or 0,yu')
read(*,*) yl,yu
c
REWIND 4
rewind 10
READ(4,5020) DENT
5020 format(A5)
write(10,5020) dent
N=0
1492 CONTINUE
N=N+1
C
READ(4,1499)
x elem(n),matx(n),evol(n),aht(n),pm(n),x(n),y(n),z(n)
1499 FORMAT(A5,10X,A5,2E10.4,4E10.4)
IF(elem(n).EQ.' ') GOTO1502
IF(N.LE.MNEL) GOTO 40
PRINT 41,MNEL
41 FORMAT(' NUMBER OF ELEMENTS SPECIFIED IN DATA BLOCK "ELEME"',
X' EXCEEDS ALLOWABLE MAXIMUM OF ',I5/
X' INCREASE PARAMETER *MNEL* IN MAIN PROGRAM, AND RECOMPILE'//
X' ----------------- SKIP FLOW SIMULATION -----------------')
stop
40 CONTINUE
GOTO 1492
1502 NEL=N-1
C
c.....assign inactive element in record # nel+1
elem(nel+1)='ina '
matx(nel+1)=' '
evol(nel+1)=0.
aht(nel+1)=0.
pm(nel+1)=0.
x(nel+1)=0.
y(nel+1)=0.
z(nel+1)=0.
iel=1
c.....search for elements in inactive domains, and place them after
c element *ina *
c
do10 n=1,nel
if((yu.eq.0..and.y(n).le.yl).or.
x(yl.eq.0..and.y(n).ge.yu)) then
c.....come here for element in inactive domain
iel=iel+1
elem(nel+iel)=elem(n)
matx(nel+iel)=matx(n)
evol(nel+iel)=evol(n)
aht(nel+iel)=aht(n)
pm(nel+iel)=pm(n)
x(nel+iel)=x(n)
y(nel+iel)=y(n)
z(nel+iel)=z(n)
else
endif
10 continue
c
c.....now write elements out to file 'MINC', skipping over inactive
c elements in locations n.le.nel
c
inel=nel+iel
do12 n=1,inel
if(n.le.nel.and.((yu.eq.0..and.y(n).le.yl).or.
x(yl.eq.0..and.y(n).ge.yu))) goto12
write(10,1499)
x elem(n),matx(n),evol(n),aht(n),pm(n),x(n),y(n),z(n)
12 continue
WRITE(10,1508)
1508 FORMAT(' ')
c
iel1=iel-1
c
print 13,nel,iel1
13 format(' ON FILE *MESH* HAVE READ',I5,' ELEMENTS'/
x1X,I5,' ELEMENTS HAVE BEEN FOUND TO BELONG TO INACTIVE',
x' y-INTERVAL'/
x' THESE ELEMENTS HAVE BEEN PLACED IN INACTIVE POSITION'/
x' THE REVISED DATA BLOCK *ELEME* HAS BEEN WRITTEN TO FILE',
x' *MINC*')
c
stop
end