48 USE bief, ONLY : ncsize
55 INTEGER NELEM,ECKEN,NDUM,I,J,K,NBV1,NBV2,PARAM(10)
58 INTEGER I_S, I_SP, I_LEN
60 INTEGER IELM,NELEM2,NELMAX2,NPTFR2,NSEG2,KLOG
62 INTEGER IELEM,ND1,ND2,ND3,MBND,IFROM,ITO,IFRM1,ITOP1,KNOLG(1)
64 INTEGER,
DIMENSION(:) ,
ALLOCATABLE :: NPOIN,IPOBO,NOQ,NSEG
65 INTEGER,
DIMENSION(:,:),
ALLOCATABLE :: IKLESA
66 INTEGER,
DIMENSION(:,:),
ALLOCATABLE :: NACHB,IFANUM
67 INTEGER,
DIMENSION(:),
ALLOCATABLE :: ISEGF
70 REAL ,
DIMENSION(:) ,
ALLOCATABLE :: XORIG,YORIG
71 DOUBLE PRECISION,
DIMENSION(:) ,
ALLOCATABLE :: AREA
72 DOUBLE PRECISION,
DIMENSION(:,:),
ALLOCATABLE :: LENGTH
74 INTEGER,
DIMENSION(:,:),
ALLOCATABLE :: IKLE
75 INTEGER,
DIMENSION(:,:),
ALLOCATABLE :: IFABOR
76 INTEGER,
DIMENSION(:) ,
ALLOCATABLE :: NVOIS,IADR
78 INTEGER,
DIMENSION(:) ,
ALLOCATABLE :: NELBOR,LIHBOR
79 INTEGER,
DIMENSION(:,:),
ALLOCATABLE :: NULONE
80 INTEGER,
DIMENSION(:,:),
ALLOCATABLE :: KP1BOR
81 INTEGER,
DIMENSION(:) ,
ALLOCATABLE :: NBOR
82 INTEGER,
DIMENSION(:,:),
ALLOCATABLE :: IKLBOR
83 INTEGER,
DIMENSION(:) ,
ALLOCATABLE :: T3
84 INTEGER,
DIMENSION(:) ,
ALLOCATABLE :: NBOR0,LIHBOR0
86 INTEGER,
DIMENSION(:,:),
ALLOCATABLE :: GLOSEG
87 INTEGER,
DIMENSION(:,:),
ALLOCATABLE :: ELTSEG,ORISEG
89 INTEGER,
DIMENSION(:) ,
ALLOCATABLE :: NODENRS
90 INTEGER,
DIMENSION(:) ,
ALLOCATABLE :: IFROM1,ITOPL1
93 DOUBLE PRECISION X2,X3,Y2,Y3,SURFACC,DX,DY
98 CHARACTER(LEN=50) RESPAR
99 CHARACTER(LEN=11) EXTENS
100 CHARACTER(LEN=30) CONLIM
101 CHARACTER(LEN=7) FILETYPE
111 WRITE(
lu,*)
'I AM GREDELELMET, COUSIN OF GRETEL FROM BAW HAMBURG' 114 WRITE (
lu, advance=
'NO',
115 & fmt=
'(/,'' GLOBAL GEOMETRY FILE: '')')
122 WRITE (
lu, advance=
'NO', fmt=
'(/,'' RESULT FILE: '')')
126 WRITE (
lu,advance=
'NO',fmt=
'(/,'' NUMBER OF PROCESSORS: '')')
129 INQUIRE (file=geo,exist=is)
131 WRITE (
lu,*)
'FILE DOES NOT EXIST: ', geo
139 IF(res(i_sp-i:i_sp-i) .NE.
' ')
EXIT 145 OPEN(2,file=geo,form=
'UNFORMATTED',status=
'OLD',err=990)
147 READ(2,err=990) nbv1,nbv2
152 990
WRITE(
lu,*)
'ERROR WHEN OPENING OR READING FILE: ',geo
157 READ(2) (param(i),i=1,10)
158 IF(param(10).EQ.1)
READ(2) (param(i),i=1,6)
162 OPEN(3,file=res,form=
'UNFORMATTED',err=991)
164 991
WRITE(
lu,*)
'ERROR WHEN OPENING FILE: ',res
173 respar=res(1:i_len) // extens(nproc-1,0)
175 INQUIRE (file=respar,exist=is)
177 WRITE (
lu,*)
'FILE DOES NOT EXIST: ', respar
178 WRITE (
lu,*)
'CHECK THE NUMBER OF PROCESSORS' 179 WRITE (
lu,*)
'AND THE RESULT FILE CORE NAME' 184 OPEN(4,file=respar,form=
'UNFORMATTED',err=994)
186 994
WRITE(
lu,*)
'ERROR WHEN OPENING FILE: ',respar
197 READ(2) nelem,npoin2,ecken,ndum
198 WRITE(
lu,*)
'4 PARAMETERS IN GEOMETRY FILE' 199 WRITE(
lu,*)
'NELEM=', nelem
200 WRITE(
lu,*)
'NPOIN2=', npoin2
201 WRITE(
lu,*)
'ECKEN=', ecken
202 WRITE(
lu,*)
'NDUM=', ndum
206 ALLOCATE(npoin(nproc),stat=err)
207 CALL check_allocate(err,
'NPOIN')
208 ALLOCATE(noq(nproc),stat=err)
209 CALL check_allocate(err,
'NOQ')
210 ALLOCATE(nseg(nproc),stat=err)
211 CALL check_allocate(err,
'NSEG')
212 ALLOCATE(iklesa(3,nelem),stat=err)
213 CALL check_allocate(err,
'IKLESA')
214 ALLOCATE(ipobo(npoin2) ,stat=err)
215 CALL check_allocate(err,
'IPOBO')
217 ALLOCATE(xorig(npoin2) ,stat=err)
218 CALL check_allocate(err,
'XORIG')
219 ALLOCATE(yorig(npoin2) ,stat=err)
220 CALL check_allocate(err,
'YORIG')
222 ALLOCATE(ifabor(nelem,3),stat=err)
223 CALL check_allocate(err,
'IFABOR')
224 ALLOCATE(ikle(nelem,3),stat=err)
225 CALL check_allocate(err,
'IKLE')
226 ALLOCATE(iadr(npoin2),stat=err)
227 CALL check_allocate(err,
'IADR')
228 ALLOCATE(nvois(npoin2),stat=err)
229 CALL check_allocate(err,
'NVOIS')
230 ALLOCATE(t3(npoin2),stat=err)
231 CALL check_allocate(err,
'T3')
232 ALLOCATE(area(npoin2),stat=err)
233 CALL check_allocate(err,
'AREA')
234 ALLOCATE(nodenrs(npoin2),stat=err)
235 CALL check_allocate(err,
'NODENRS')
241 READ(2) ((iklesa(i,j),i=1,ecken),j=1,nelem)
245 READ(2) (ipobo(i),i=1,npoin2)
249 READ(2) (xorig(i),i=1,npoin2)
250 READ(2) (yorig(i),i=1,npoin2)
261 OPEN(4,file=conlim,form=
'FORMATTED',err=996)
263 996
WRITE(
lu,*)
'ERROR WHEN OPENING FILE: ',conlim
268 ALLOCATE(lihbor0(npoin2),stat=err)
269 CALL check_allocate(err,
'LIHBOR')
270 ALLOCATE(nbor0(npoin2),stat=err)
271 CALL check_allocate(err,
'NBOR')
273 READ(4,*,end=989) lihbor0(i),idum,idum,rdum,rdum,rdum,rdum,
274 & idum,rdum,rdum,rdum,nbor0(i),idum
280 ALLOCATE(lihbor(nptfr),stat=err)
281 CALL check_allocate(err,
'LIHBOR')
282 ALLOCATE(nbor(nptfr),stat=err)
283 CALL check_allocate(err,
'NBOR')
284 ALLOCATE(nelbor(nptfr),stat=err)
285 CALL check_allocate(err,
'NELBOR')
286 ALLOCATE(nulone(nptfr,2),stat=err)
287 CALL check_allocate(err,
'NULONE')
288 ALLOCATE(kp1bor(nptfr,2),stat=err)
289 CALL check_allocate(err,
'KP1BOR')
290 ALLOCATE(iklbor(nptfr,2),stat=err)
291 CALL check_allocate(err,
'IKLBOR')
292 ALLOCATE(eltseg(nelem,3),stat=err)
293 CALL check_allocate(err,
'ELTSEG')
294 ALLOCATE(oriseg(nelem,3),stat=err)
295 CALL check_allocate(err,
'ORISEG')
305 lihbor(i) = lihbor0(i)
306 IF (lihbor(i).NE.2)
THEN 308 nodenrs(nbor(i)) = -mbnd
329 ikle(j,i)=iklesa(i,j)
333 IF(ielm.EQ.11.OR.ielm.EQ.41.OR.ielm.EQ.51)
THEN 335 ALLOCATE(nachb(1,1),stat=err)
336 CALL check_allocate(err,
'NACHB')
338 CALL voisin(ifabor,nelem2,nelem,ielm,ikle,
340 & npoin2,nachb,nbor,nptfr,iadr,nvois)
343 maxnvois = maxval(nvois)/2
346 WRITE(
lu,*)
'UNEXPECTED ELEMENT IN INBIEF:',ielm
351 IF(ielm.EQ.11.OR.ielm.EQ.41.OR.ielm.EQ.51)
THEN 353 ALLOCATE(ifanum(1,1),stat=err)
354 CALL check_allocate(err,
'IFANUM')
355 ALLOCATE(isegf(nptfr),stat=err)
356 CALL check_allocate(err,
'ISEG')
358 CALL elebd(nelbor,nulone,kp1bor,
359 & ifabor,nbor,ikle,nelem,
360 & iklbor,nelem2,nelmax2,
361 & npoin2,nptfr2,ielm,
364 & iadr,nvois,t3,nptfr2,idum)
370 WRITE(
lu,*)
'UNEXPECTED ELEMENT IN INBIEF:',ielm
382 nseg2 = (3*nelem+nptfr)/2
383 ALLOCATE(length(2,nseg2+mbnd),stat=err)
384 CALL check_allocate(err,
'LENGTH')
385 ALLOCATE(gloseg(nseg2,2),stat=err)
386 CALL check_allocate(err,
'GLOSEG')
387 ALLOCATE(ifrom1(nseg2),stat=err)
388 CALL check_allocate(err,
'IFROM1')
389 ALLOCATE(itopl1(nseg2),stat=err)
390 CALL check_allocate(err,
'ITOPL1')
392 CALL stoseg(ifabor,nelem,nelmax2,nelmax2,ielm,ikle,
395 & eltseg,oriseg,nseg2,
396 & nelbor,nulone,knolg,iklbor,nptfr ,nptfr)
400 IF(filetype(1:6).EQ.
'AREA2D')
THEN 408 x2 = dble(xorig(nd2))-dble(xorig(nd1))
409 x3 = dble(xorig(nd3))-dble(xorig(nd1))
410 y2 = dble(yorig(nd2))-dble(yorig(nd1))
411 y3 = dble(yorig(nd3))-dble(yorig(nd1))
412 surfacc = 0.5d0*(x2*y3-x3*y2)
413 area(nd1) = area(nd1)+surfacc/3.d0
414 area(nd2) = area(nd2)+surfacc/3.d0
415 area(nd3) = area(nd3)+surfacc/3.d0
417 ELSEIF(filetype(1:6).EQ.
'LENGTH')
THEN 419 dx = dble(xorig(gloseg(iseg,1))) - dble(xorig(gloseg(iseg,2)))
420 dy = dble(yorig(gloseg(iseg,1))) - dble(yorig(gloseg(iseg,2)))
421 length(1,iseg) = sqrt(dx**2+dy**2)*0.5d0
422 length(2,iseg) = length(1,iseg)
425 IF (lihbor(i).NE.2 )
THEN 426 ifrom = nodenrs(nbor(i))
427 length(1,nseg2-ifrom) = 10.0d0
428 length(2,nseg2-ifrom) = 10.0d0
433 IF(filetype(1:6).EQ.
'AREA2D')
THEN 434 WRITE(3) npoin2,0,npoin2,npoin2,npoin2,0
435 WRITE(3) (
REAL(AREA(I)),I=1,npoin2)
436 ELSEIF(filetype(1:6).EQ.
'LENGTH')
THEN 444 WRITE(3) 0,(((
REAL(LENGTH(I,J)),I=1,2),j=1,nseg2+mbnd),
445 & k=1,nplan), ((1.0,1.0), k=1,(nplan-1)*npoin2)
448 ELSEIF(filetype(1:6).EQ.
'IFRMTO')
THEN 451 ifrom = gloseg(iseg,1)
455 & npoin2,ifrom1(iseg),itopl1(iseg))
456 IF ( ifrom1(iseg) .LT. 0 .AND.
457 & ifrom1(iseg) .NE. nodenrs(ifrom) )
THEN 459 IF ( nodenrs(i) .EQ. ifrom1(iseg) )
THEN 465 IF ( itopl1(iseg) .LT. 0 .AND.
466 & itopl1(iseg) .NE. nodenrs(ito ) )
THEN 468 IF ( nodenrs(i) .EQ. itopl1(iseg) )
THEN 477 ifrom = ifrom + (k-1)*npoin2
478 IF ( ifrm1 .GT. 0 )
THEN 479 ifrm1 = ifrm1 + (k-1)*npoin2
481 ifrm1 = ifrm1 - (k-1)*mbnd
483 ito = ito + (k-1)*npoin2
484 IF ( itop1 .GT. 0 )
THEN 485 itop1 = itop1 + (k-1)*npoin2
487 itop1 = itop1 - (k-1)*mbnd
489 WRITE(3) ifrom,ito,ifrm1,itop1
492 IF ( lihbor(i) .NE. 2 )
THEN 493 ifrom = nodenrs(nbor(i))
497 ifrom = ifrom - (k-1)*mbnd
498 ifrm1 = ifrm1 - (k-1)*mbnd
499 ito = ito + (k-1)*npoin2
500 itop1 = itop1 + (k-1)*npoin2
501 WRITE(3)ifrom,ito,ifrm1,itop1
518 ifrm1 = ifrom + max(k-2, 0 )*npoin2
519 itop1 = ifrom + min(k+1,nplan-1)*npoin2
520 ifrom = ifrom + ( k-1 )*npoin2
522 WRITE (3) ifrom,ito,ifrm1,itop1
528 WRITE(
lu,*)
'END OF PROGRAM '
subroutine gredel_fdnrst(IFRM, ITO, X, Y, NODENRS, NPOIN2, IFRM1, ITOP1)
subroutine voisin(IFABOR, NELEM, NELMAX, IELM, IKLE, SIZIKL, NPOIN, NACHB, NBOR, NPTFR, IADR, NVOIS)
subroutine stoseg(IFABOR, NELEM, NELMAX, NELMAX2, IELM, IKLE, NBOR, NPTFR, GLOSEG, MAXSEG, ELTSEG, ORISEG, NSEG, NELBOR, NULONE, KNOLG, IKLBOR, NELEBX, NELEB)
subroutine elebd(NELBOR, NULONE, KP1BOR, IFABOR, NBOR, IKLE, SIZIKL, IKLBOR, NELEM, NELMAX, NPOIN, NPTFR, IELM, LIHBOR, KLOG, ISEG, T1, T2, T3, NELEBX, NELEB)