The TELEMAC-MASCARET system  trunk
gredelmet_autop.f
Go to the documentation of this file.
1 ! ***********************
2  PROGRAM gredelmet_autop
3 ! ***********************
4 !
5 !
6 !***********************************************************************
7 ! PARALLEL V7P0 27/03/2014
8 !***********************************************************************
9 !
10 !brief MERGES THE RESULTS OF A PARALLEL COMPUTATION (COUPLING
11 !+ WITH DELWAQ) TO WRITE A SINGLE FILE IN DELWAQ FORMAT.
12 !
13 !history JAJ
14 !+ 2001/2
15 !+
16 !+ SLIGHTLY CHANGED TO DEAL WITH:
17 !
18 !history HW, BAW-HAMBURG
19 !+ 20/02/2003
20 !+
21 !+ IMPROVED READING OF DATASETS
22 !
23 !history JAJ
24 !+ 14/03/2003
25 !+
26 !+ ADDED EXIT CODES
27 !
28 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
29 !+ 13/07/2010
30 !+ V6P0
31 !+ Translation of French comments within the FORTRAN sources into
32 !+ English comments
33 !
34 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
35 !+ 21/08/2010
36 !+ V6P0
37 !+ Creation of DOXYGEN tags for automated documentation and
38 !+ cross-referencing of the FORTRAN sources
39 !
40 !history J-M HERVOUET (EDF LAB, LNHE)
41 !+ 27/03/2014
42 !+ V7P0
43 !+ Calls of stoseg and elebd modified.
44 !
45 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
46 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
47 !
48  USE bief, ONLY : ncsize
50  IMPLICIT NONE
51 !
52  CHARACTER(LEN=30) GEO
53 !
54  INTEGER ERR
55  INTEGER NELEM,ECKEN,NDUM,I,J,K,NBV1,NBV2,PARAM(10)
56  INTEGER NPLAN,NPOIN2
57  INTEGER NPROC
58  INTEGER I_S, I_SP, I_LEN
59  INTEGER IDUM, NPTFR
60  INTEGER IELM,NELEM2,NELMAX2,NPTFR2,NSEG2,KLOG
61  INTEGER MAXNVOIS,ISEG
62  INTEGER IELEM,ND1,ND2,ND3,MBND,IFROM,ITO,IFRM1,ITOP1,KNOLG(1)
63 !
64  INTEGER, DIMENSION(:) , ALLOCATABLE :: NPOIN,IPOBO,NOQ,NSEG
65  INTEGER, DIMENSION(:,:), ALLOCATABLE :: IKLESA
66  INTEGER, DIMENSION(:,:), ALLOCATABLE :: NACHB,IFANUM
67  INTEGER, DIMENSION(:), ALLOCATABLE :: ISEGF
68 !
69 !
70  REAL , DIMENSION(:) , ALLOCATABLE :: XORIG,YORIG
71  DOUBLE PRECISION, DIMENSION(:) , ALLOCATABLE :: AREA
72  DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: LENGTH
73 !
74  INTEGER, DIMENSION(:,:), ALLOCATABLE :: IKLE ! IKLE(SIZIKL,*) OU IKLE(NELMAX,*)
75  INTEGER, DIMENSION(:,:), ALLOCATABLE :: IFABOR ! IFABOR(NELMAX,*) OU IFABOR(NELMAX2,*)
76  INTEGER, DIMENSION(:) , ALLOCATABLE :: NVOIS,IADR ! NVOIS(NPOIN),IADR(NPOIN)
77 !
78  INTEGER, DIMENSION(:) , ALLOCATABLE :: NELBOR,LIHBOR ! NELBOR(NPTFR),LIHBOR(NPTFR)
79  INTEGER, DIMENSION(:,:), ALLOCATABLE :: NULONE ! NULONE(NPTFR,2) OU NULONE(NPTFR)
80  INTEGER, DIMENSION(:,:), ALLOCATABLE :: KP1BOR ! KP1BOR(NPTFR,2) OU KP1BOR(NPTFR)
81  INTEGER, DIMENSION(:) , ALLOCATABLE :: NBOR ! NBOR(*)
82  INTEGER, DIMENSION(:,:), ALLOCATABLE :: IKLBOR ! IKLBOR(NPTFR,2)
83  INTEGER, DIMENSION(:) , ALLOCATABLE :: T3 ! T3(NPOIN)
84  INTEGER, DIMENSION(:) , ALLOCATABLE :: NBOR0,LIHBOR0 ! NBOR0(NPTFR),LIHBOR0(NPTFR)
85 !
86  INTEGER, DIMENSION(:,:), ALLOCATABLE :: GLOSEG ! GLOSEG(MAXSEG,2)
87  INTEGER, DIMENSION(:,:), ALLOCATABLE :: ELTSEG,ORISEG ! ELTSEG(NELMAX,*),ORISEG(NELMAX,3)
88 !
89  INTEGER, DIMENSION(:) , ALLOCATABLE :: NODENRS
90  INTEGER, DIMENSION(:) , ALLOCATABLE :: IFROM1,ITOPL1
91 !
92  REAL RDUM
93  DOUBLE PRECISION X2,X3,Y2,Y3,SURFACC,DX,DY
94 !
95  LOGICAL IS
96 !
97  CHARACTER(LEN=30) RES
98  CHARACTER(LEN=50) RESPAR
99  CHARACTER(LEN=11) EXTENS
100  CHARACTER(LEN=30) CONLIM
101  CHARACTER(LEN=7) FILETYPE
102  EXTERNAL extens
103  INTRINSIC maxval
104 !
105  li=5
106  lu=6
107  lng=2
108 !HW
109 !JAJ INTRODUCE YOURSELF WITH THE RELEASE DATE
110 !
111  WRITE(lu,*) 'I AM GREDELELMET, COUSIN OF GRETEL FROM BAW HAMBURG'
112  WRITE(lu,*)
113 !
114  WRITE (lu, advance='NO',
115  & fmt='(/,'' GLOBAL GEOMETRY FILE: '')')
116 ! REWIND(LI)
117  READ(li,*) geo
118  WRITE(lu,*) geo
119 !
120 ! READS FILENAMES AND THE NUMBER OF PROCESSORS / PARTITIONS
121 !
122  WRITE (lu, advance='NO', fmt='(/,'' RESULT FILE: '')')
123  READ(li,*) res
124  WRITE(lu,*) res
125 !
126  WRITE (lu,advance='NO',fmt='(/,'' NUMBER OF PROCESSORS: '')')
127  READ (li,*) nproc
128  WRITE(lu,*) nproc
129  INQUIRE (file=geo,exist=is)
130  IF (.NOT.is) THEN
131  WRITE (lu,*) 'FILE DOES NOT EXIST: ', geo
132  CALL plante(1)
133  stop
134  END IF
135 !
136  i_s = len(res)
137  i_sp = i_s + 1
138  DO i=1,i_s
139  IF(res(i_sp-i:i_sp-i) .NE. ' ') EXIT
140  ENDDO
141  i_len=i_sp - i
142 !
143 ! GEOMETRY FILE, READ UNTIL 10 PARAMETERS:
144 !
145  OPEN(2,file=geo,form='UNFORMATTED',status='OLD',err=990)
146  READ(2,err=990)
147  READ(2,err=990) nbv1,nbv2
148  DO i=1,nbv1+nbv2
149  READ(2,err=990)
150  ENDDO ! I
151  GO TO 992
152 990 WRITE(lu,*) 'ERROR WHEN OPENING OR READING FILE: ',geo
153  CALL plante(1)
154  stop
155 992 CONTINUE
156 ! READS THE 10 PARAMETERS AND THE DATE
157  READ(2) (param(i),i=1,10)
158  IF(param(10).EQ.1) READ(2) (param(i),i=1,6)
159 !
160 ! RESULTS FILE:
161 !
162  OPEN(3,file=res,form='UNFORMATTED',err=991)
163  GO TO 993
164 991 WRITE(lu,*) 'ERROR WHEN OPENING FILE: ',res
165  CALL plante(1)
166  stop
167 993 CONTINUE
168 !
169 ! 1) READS THE BEGINNING OF THE FIRST RESULTS FILE
170 !
171 !CC RESPAR=RES // EXTENS(2**IDIMS-1,0)
172 !
173  respar=res(1:i_len) // extens(nproc-1,0)
174 !
175  INQUIRE (file=respar,exist=is)
176  IF (.NOT.is) THEN
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'
180  CALL plante(1)
181  stop
182  END IF
183 !
184  OPEN(4,file=respar,form='UNFORMATTED',err=994)
185  GO TO 995
186 994 WRITE(lu,*) 'ERROR WHEN OPENING FILE: ',respar
187  CALL plante(1)
188  stop
189 995 CONTINUE
190 !
191  READ(4) filetype
192  READ(4) nplan
193  CLOSE(4)
194 !
195 ! 5 : 4 PARAMETERS
196 !
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
203 !
204 ! DYNAMICALLY ALLOCATES THE ARRAYS
205 !
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')
216 ! X AND Y
217  ALLOCATE(xorig(npoin2) ,stat=err)
218  CALL check_allocate(err, 'XORIG')
219  ALLOCATE(yorig(npoin2) ,stat=err)
220  CALL check_allocate(err, 'YORIG')
221 !
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')
236 !
237 ! END OF ALLOCATION ...
238 !
239 ! 6 : IKLE
240 !
241  READ(2) ((iklesa(i,j),i=1,ecken),j=1,nelem)
242 !
243 ! 7 : IPOBO
244 !
245  READ(2) (ipobo(i),i=1,npoin2)
246 !
247 ! 8 : X AND Y, WILL BE CHECKED LATER ...
248 !
249  READ(2) (xorig(i),i=1,npoin2)
250  READ(2) (yorig(i),i=1,npoin2)
251 !
252 !----------------------------------------------------------------------
253 !
254 !
255  IF(nplan.LE.1) THEN
256  conlim = "T2DCLI"
257  ELSE
258  conlim = "T3DCLI"
259  ENDIF
260 !
261  OPEN(4,file=conlim,form='FORMATTED',err=996)
262  GO TO 997
263  996 WRITE(lu,*) 'ERROR WHEN OPENING FILE: ',conlim
264  CALL plante(1)
265  stop
266  997 CONTINUE
267 !
268  ALLOCATE(lihbor0(npoin2),stat=err)
269  CALL check_allocate(err, 'LIHBOR')
270  ALLOCATE(nbor0(npoin2),stat=err)
271  CALL check_allocate(err, 'NBOR')
272  DO i=1,npoin2
273  READ(4,*,end=989) lihbor0(i),idum,idum,rdum,rdum,rdum,rdum,
274  & idum,rdum,rdum,rdum,nbor0(i),idum
275  ENDDO
276 !
277  CLOSE(4)
278  989 nptfr=i-1
279 !
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')
296 !
297  mbnd=0
298 !
299  DO i=1,npoin2
300  nodenrs(i) = i
301  ENDDO
302 !
303  DO i=1,nptfr
304  nbor(i) = nbor0(i)
305  lihbor(i) = lihbor0(i)
306  IF (lihbor(i).NE.2) THEN
307  mbnd = mbnd + 1
308  nodenrs(nbor(i)) = -mbnd
309  ENDIF
310  ENDDO
311 !
312 !------------------------------------------------------------------------------
313 !
314 ! LOCAL CONSTRUCTION OF GLOSEG
315 !
316 !------------------------------------------------------------------------------
317 !
318 ! WITH PRISMS, DIFFERENT FROM 2D VALUES, OTHERWISE
319 !
320  ielm = 11 ! WARNING: IS HARD-CODED !!!
321  nelem2 =nelem
322  nelmax2 =nelem
323  nptfr2 =nptfr
324 !
325 ! NEIGHBOURS OF THE BOUNDARY SIDES FOR TRIANGULAR MESH
326 !
327  DO j=1,nelem
328  DO i=1,3
329  ikle(j,i)=iklesa(i,j)
330  ENDDO
331  ENDDO
332  ncsize = 1
333  IF(ielm.EQ.11.OR.ielm.EQ.41.OR.ielm.EQ.51) THEN
334  ! DUMMY ARRAY
335  ALLOCATE(nachb(1,1),stat=err)
336  CALL check_allocate(err, 'NACHB')
337 !
338  CALL voisin(ifabor,nelem2,nelem,ielm,ikle,
339  & nelem,
340  & npoin2,nachb,nbor,nptfr,iadr,nvois)
341 !
342  DEALLOCATE(nachb)
343  maxnvois = maxval(nvois)/2
344 !
345  ELSE
346  WRITE(lu,*) 'UNEXPECTED ELEMENT IN INBIEF:',ielm
347  CALL plante(1)
348  stop
349  ENDIF
350  klog = 2 ! SOLID BOUNDARY CONDITION: IS HARD-CODED !!!
351  IF(ielm.EQ.11.OR.ielm.EQ.41.OR.ielm.EQ.51) THEN
352  ! Dummy arrays
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')
357 !
358  CALL elebd(nelbor,nulone,kp1bor,
359  & ifabor,nbor,ikle,nelem,
360  & iklbor,nelem2,nelmax2,
361  & npoin2,nptfr2,ielm,
362  & lihbor,klog,
363  & isegf,
364  & iadr,nvois,t3,nptfr2,idum)
365 ! NELEBX,NELEB (HERE EQUAL TO NPTFR2)
366 ! NELEB IS INOUT => DUMMY
367  DEALLOCATE(ifanum)
368  DEALLOCATE(isegf)
369  ELSE
370  WRITE(lu,*) 'UNEXPECTED ELEMENT IN INBIEF:',ielm
371  CALL plante(1)
372  stop
373  ENDIF
374 !
375 !-----------------------------------------------------------------------
376 !
377 ! DATA STRUCTURE FOR EDGE-BASED STORAGE (FROM 5.9 ON ALWAYS DONE IN 2D)
378 ! SEE CALL TO COMP_SEG BELOW FOR COMPLETING THE STRUCTURE
379 !
380  IF(ielm.EQ.11) THEN
381 !
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')
391 !
392  CALL stoseg(ifabor,nelem,nelmax2,nelmax2,ielm,ikle,
393  & nbor,nptfr,
394  & gloseg,nseg2, ! GLOSEG%MAXDIM1,
395  & eltseg,oriseg,nseg2,
396  & nelbor,nulone,knolg,iklbor,nptfr ,nptfr)
397 ! NELENX,NELEB (HERE EQUAL TO NPTFR)
398  ENDIF
399 !
400  IF(filetype(1:6).EQ.'AREA2D') THEN
401  DO i=1,npoin2
402  area(i)=0.d0
403  ENDDO
404  DO ielem=1,nelem2
405  nd1 = ikle(ielem,1)
406  nd2 = ikle(ielem,2)
407  nd3 = ikle(ielem,3)
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
416  ENDDO
417  ELSEIF(filetype(1:6).EQ.'LENGTH') THEN
418  DO iseg=1,nseg2
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)
423  ENDDO
424  DO i = 1, nptfr2 ! LP 05/04/2009
425  IF (lihbor(i).NE.2 ) THEN ! OPEN BOUNDARY
426  ifrom = nodenrs(nbor(i)) ! EXCHANGES ADDED
427  length(1,nseg2-ifrom) = 10.0d0 ! DUMMY LENGTH
428  length(2,nseg2-ifrom) = 10.0d0
429  ENDIF
430  ENDDO
431  ENDIF
432 !
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
437 ! WRITE(3) 0
438 ! DO K=1,NPLAN
439 ! WRITE(3) ((REAL(LENGTH(I,J)),I=1,2),J=1,NSEG2+MBND)
440 ! ENDDO
441 ! DO K=1,NPLAN-1
442 ! WRITE(3) (1.0, I=1,NPOIN2*2)
443 ! ENDDO
444  WRITE(3) 0,(((REAL(LENGTH(I,J)),I=1,2),j=1,nseg2+mbnd), ! LP 27/02/2011
445  & k=1,nplan), ((1.0,1.0), k=1,(nplan-1)*npoin2) ! BECAUSE OF
446 ! ! UNFORMATTED FILES
447 ! ! ALL NOW IN 1 RECORD
448  ELSEIF(filetype(1:6).EQ.'IFRMTO') THEN
449  DO k=1,nplan
450  DO iseg=1,nseg2
451  ifrom = gloseg(iseg,1)
452  ito = gloseg(iseg,2)
453  IF ( k.EQ.1 ) THEN
454  CALL gredel_fdnrst(ifrom,ito,xorig,yorig,nodenrs,
455  & npoin2,ifrom1(iseg),itopl1(iseg))
456  IF ( ifrom1(iseg) .LT. 0 .AND. ! *START* LP 24/04/2009
457  & ifrom1(iseg) .NE. nodenrs(ifrom) ) THEN
458  DO i = 1,npoin2
459  IF ( nodenrs(i) .EQ. ifrom1(iseg) ) THEN
460  ifrom1(iseg) = i
461  EXIT
462  ENDIF
463  ENDDO
464  ENDIF
465  IF ( itopl1(iseg) .LT. 0 .AND.
466  & itopl1(iseg) .NE. nodenrs(ito ) ) THEN
467  DO i = 1,npoin2
468  IF ( nodenrs(i) .EQ. itopl1(iseg) ) THEN
469  itopl1(iseg) = i
470  EXIT
471  ENDIF
472  ENDDO
473  ENDIF ! **END** LP 24/04/2009
474  ENDIF
475  ifrm1 = ifrom1(iseg)
476  itop1 = itopl1(iseg)
477  ifrom = ifrom + (k-1)*npoin2
478  IF ( ifrm1 .GT. 0 ) THEN
479  ifrm1 = ifrm1 + (k-1)*npoin2
480  ELSE
481  ifrm1 = ifrm1 - (k-1)*mbnd ! LP 24/04/2009
482  ENDIF
483  ito = ito + (k-1)*npoin2
484  IF ( itop1 .GT. 0 ) THEN
485  itop1 = itop1 + (k-1)*npoin2
486  ELSE
487  itop1 = itop1 - (k-1)*mbnd ! LP 24/04/2009
488  ENDIF
489  WRITE(3) ifrom,ito,ifrm1,itop1
490  ENDDO
491  DO i=1,nptfr2 ! LP 05/04/2009
492  IF ( lihbor(i) .NE. 2 ) THEN ! OPEN BOUNDARY
493  ifrom = nodenrs(nbor(i)) ! EXCHANGES ADDED
494  ito = nbor(i)
495  ifrm1 = ifrom
496  itop1 = ito
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
502  ENDIF
503  ENDDO
504 ! THE WRITING OF EXCHANGE POINTERS IS CHANGED **END** LP 05/04/2009
505  ENDDO
506 !
507 ! DERIVE THE FROM-TO EXCHANGE TABLE FOR COMPUTATIONAL ELEMENTS
508 ! VERTICALLY FOR ALL LAYERS. THE LAYERS DIFFER NPOIN2 IN
509 ! COMPUTATIONAL ELEMENT NUMBER. BOUNDARY NODES HAVE NO VERTICAL FLOW
510 ! WRITE 1.0 FOR THE VERTICAL 'FROM' AND 'TO' HALFDISTANCES
511 ! THEY ARE UPDATED BY WAQ TO BECOME VOLUME/AREA/2.0 DURING
512 ! SIMULATION TIME, SINCE VERTICAL DISTANCES CHANGE WITH VOLUME.
513 !
514  DO k=1,nplan-1
515  DO i=1,npoin2
516 ! THE WRITING OF EXCHANGE POINTERS IS CHANGED *START* LP 05/04/2009
517  ifrom = i
518  ifrm1 = ifrom + max(k-2, 0 )*npoin2
519  itop1 = ifrom + min(k+1,nplan-1)*npoin2
520  ifrom = ifrom + ( k-1 )*npoin2
521  ito = ifrom + npoin2
522  WRITE (3) ifrom,ito,ifrm1,itop1
523 ! THE WRITING OF EXCHANGE POINTERS IS CHANGED **END** LP 05/04/2009
524  ENDDO
525  ENDDO ! WAQ COMPUTES THEM ON THE FLY FROM VOLUMES
526  ENDIF
527 !
528  WRITE(lu,*) 'END OF PROGRAM '
529 !
530  CLOSE(2)
531  CLOSE(3)
532 !
533  stop 0
534  END PROGRAM gredelmet_autop
program gredelmet_autop
subroutine gredel_fdnrst(IFRM, ITO, X, Y, NODENRS, NPOIN2, IFRM1, ITOP1)
Definition: gredel_fdnrst.f:6
subroutine voisin(IFABOR, NELEM, NELMAX, IELM, IKLE, SIZIKL, NPOIN, NACHB, NBOR, NPTFR, IADR, NVOIS)
Definition: voisin.f:8
subroutine stoseg(IFABOR, NELEM, NELMAX, NELMAX2, IELM, IKLE, NBOR, NPTFR, GLOSEG, MAXSEG, ELTSEG, ORISEG, NSEG, NELBOR, NULONE, KNOLG, IKLBOR, NELEBX, NELEB)
Definition: stoseg.f:9
subroutine elebd(NELBOR, NULONE, KP1BOR, IFABOR, NBOR, IKLE, SIZIKL, IKLBOR, NELEM, NELMAX, NPOIN, NPTFR, IELM, LIHBOR, KLOG, ISEG, T1, T2, T3, NELEBX, NELEB)
Definition: elebd.f:9
Definition: bief.f:3