The TELEMAC-MASCARET system  trunk
gredelseg_autop.f
Go to the documentation of this file.
1 ! ***********************
2  PROGRAM gredelseg_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
49  USE declarations_special
50  IMPLICIT NONE
51 !
52  CHARACTER(LEN=30) GEO
53 !
54  INTEGER IPID,ERR,FU
55  INTEGER NELEM,ECKEN,NDUM,I,J,K,NBV1,NBV2,PARAM(10)
56  INTEGER NPLAN,NPOIN2,NPOIN2LOC,NOQ2,NPLANLOC,NSEG2LOC,NOQ2LOC
57  INTEGER MBNDLOC,NPTFRLOC
58  INTEGER NPROC,NRESU,NPOINMAX,NSEGMAX,NOQMAX,NPTFRMAX
59  INTEGER I_S, I_SP, I_LEN
60  INTEGER IT
61  INTEGER IDUM, NPTFR
62  INTEGER IELM,NELEM2,NELMAX2,NPTFR2,NSEG2,KLOG,MBND2
63  INTEGER MAXNVOIS,ISEG,IG1,IG2,IGTEMP,IVOIS,IL1,IL2
64 !
65  INTEGER, DIMENSION(:) , ALLOCATABLE :: NPOIN,VERIF,NOQ,NSEG
66  INTEGER, DIMENSION(:) , ALLOCATABLE :: MBND,NODENRS,NPTFRL
67  INTEGER, DIMENSION(:,:), ALLOCATABLE :: KNOLG,KSEGLG
68  INTEGER, DIMENSION(:,:), ALLOCATABLE :: NODENRSLOC,NBORLOC
69  INTEGER, DIMENSION(:,:), ALLOCATABLE :: LIHBORLOC
70  INTEGER, DIMENSION(:,:), ALLOCATABLE :: IKLESA
71  INTEGER, DIMENSION(:,:), ALLOCATABLE :: NACHB,IFANUM
72  INTEGER, DIMENSION(:), ALLOCATABLE :: ISEGF
73 !
74 !
75  REAL , DIMENSION(:) , ALLOCATABLE :: GLOBAL_VALUE
76  REAL , DIMENSION(:) , ALLOCATABLE :: LOCAL_VALUE
77 !
78  INTEGER, DIMENSION(:,:), ALLOCATABLE :: IKLE ! IKLE(SIZIKL,*) OU IKLE(NELMAX,*)
79  INTEGER, DIMENSION(:,:), ALLOCATABLE :: IFABOR ! IFABOR(NELMAX,*) OU IFABOR(NELMAX2,*)
80  INTEGER, DIMENSION(:) , ALLOCATABLE :: NVOIS,IADR ! NVOIS(NPOIN),IADR(NPOIN)
81 !
82  INTEGER, DIMENSION(:) , ALLOCATABLE :: NELBOR,LIHBOR ! NELBOR(NPTFR),LIHBOR(NPTFR)
83  INTEGER, DIMENSION(:,:), ALLOCATABLE :: NULONE ! NULONE(NPTFR,2) OU NULONE(NPTFR)
84  INTEGER, DIMENSION(:,:), ALLOCATABLE :: KP1BOR ! KP1BOR(NPTFR,2) OU KP1BOR(NPTFR)
85  INTEGER, DIMENSION(:) , ALLOCATABLE :: NBOR ! NBOR(*)
86  INTEGER, DIMENSION(:,:), ALLOCATABLE :: IKLBOR ! IKLBOR(NPTFR,2)
87  INTEGER, DIMENSION(:) , ALLOCATABLE :: T3 ! T3(NPOIN)
88  INTEGER, DIMENSION(:) , ALLOCATABLE :: NBOR0,LIHBOR0 ! NBOR0(NPTFR),LIHBOR0(NPTFR)
89 !
90  INTEGER, DIMENSION(:,:), ALLOCATABLE :: GLOSEG ! GLOSEG(MAXSEG,2)
91  INTEGER, DIMENSION(:,:), ALLOCATABLE :: ELTSEG,ORISEG ! ELTSEG(NELMAX,*),ORISEG(NELMAX,3)
92 !
93  INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: GLOSEGLOC
94  INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: SEGMENT
95 !
96  REAL RDUM
97 !
98  LOGICAL IS,ENDE
99 !
100  CHARACTER(LEN=30) RES
101  CHARACTER(LEN=50) RESPAR
102  CHARACTER(LEN=11) EXTENS
103  CHARACTER(LEN=30) CONLIM
104  CHARACTER(LEN=7) FILETYPE
105  EXTERNAL extens
106  INTRINSIC maxval
107 !
108  li=5
109  lu=6
110  lng=2
111 !HW
112 !JAJ INTRODUCE YOURSELF WITH THE RELEASE DATE
113 !
114  WRITE(lu,*) 'I AM GREDELSEG, COUSIN OF GRETEL FROM BAW HAMBURG'
115  WRITE(lu,*)
116 !
117 ! READS FILENAMES AND THE NUMBER OF PROCESSORS / PARTITIONS
118 !
119  WRITE (lu, advance='NO',
120  & fmt='(/,'' GLOBAL GEOMETRY FILE: '')')
121 ! REWIND(LI)
122  READ(li,*) geo
123  WRITE(lu,*) geo
124 !
125  WRITE (lu, advance='NO', fmt='(/,'' RESULT FILE: '')')
126  READ(li,*) res
127  WRITE(lu,*) res
128 !
129  WRITE (lu,advance='NO',fmt='(/,'' NUMBER OF PROCESSORS: '')')
130  READ (li,*) nproc
131  WRITE(lu,*) nproc
132 !
133  INQUIRE (file=geo,exist=is)
134  IF (.NOT.is) THEN
135  WRITE (lu,*) 'FILE DOES NOT EXIST: ', geo
136  CALL plante(1)
137  stop
138  END IF
139 !
140  i_s = len(res)
141  i_sp = i_s + 1
142  DO i=1,i_s
143  IF(res(i_sp-i:i_sp-i) .NE. ' ') EXIT
144  ENDDO
145  i_len=i_sp - i
146 !
147 ! GEOMETRY FILE, READ UNTIL 10 PARAMETERS:
148 !
149  OPEN(2,file=geo,form='UNFORMATTED',status='OLD',err=990)
150  READ(2,err=990)
151  READ(2,err=990) nbv1,nbv2
152  DO i=1,nbv1+nbv2
153  READ(2,err=990)
154  ENDDO ! I
155  GO TO 992
156 990 WRITE(lu,*) 'ERROR WHEN OPENING OR READING FILE: ',geo
157  CALL plante(1)
158  stop
159 992 CONTINUE
160 ! READS THE 10 PARAMETERS AND THE DATE
161  READ(2) (param(i),i=1,10)
162  IF(param(10).EQ.1) READ(2) (param(i),i=1,6)
163 !
164 ! RESULTS FILE:
165 !
166  OPEN(3,file=res,form='UNFORMATTED',err=991)
167  GO TO 993
168 991 WRITE(lu,*) 'ERROR WHEN OPENING FILE: ',res
169  CALL plante(1)
170  stop
171 993 CONTINUE
172 !
173 ! 1) READS THE BEGINNING OF THE FIRST RESULTS FILE
174 !
175 !CC RESPAR=RES // EXTENS(2**IDIMS-1,0)
176 !
177  respar=res(1:i_len) // extens(nproc-1,0)
178 !
179  INQUIRE (file=respar,exist=is)
180  IF (.NOT.is) THEN
181  WRITE (lu,*) 'FILE DOES NOT EXIST: ', respar
182  WRITE (lu,*) 'CHECK THE NUMBER OF PROCESSORS'
183  WRITE (lu,*) 'AND THE RESULT FILE CORE NAME'
184  CALL plante(1)
185  stop
186  END IF
187 !
188  OPEN(4,file=respar,form='UNFORMATTED',err=994)
189  GO TO 995
190 994 WRITE(lu,*) 'ERROR WHEN OPENING FILE: ',respar
191  CALL plante(1)
192  stop
193 995 CONTINUE
194 !
195  READ(4) filetype
196  READ(4) npoin2
197  READ(4) nseg2loc
198  READ(4) mbndloc
199  READ(4) noq2loc
200  READ(4) nplan
201  IF(nplan.EQ.1) nplan = 0
202 !
203  CLOSE(4)
204 !
205 ! 5 : 4 PARAMETERS
206 !
207  READ(2) nelem,npoin2,ecken,ndum
208  WRITE(lu,*) '4 PARAMETERS IN GEOMETRY FILE'
209  WRITE(lu,*) 'NELEM=', nelem
210  WRITE(lu,*) 'NPOIN2=', npoin2
211  WRITE(lu,*) 'ECKEN=', ecken
212  WRITE(lu,*) 'NDUM=', ndum
213 !
214 ! DYNAMICALLY ALLOCATES THE ARRAYS
215 !
216  ALLOCATE(npoin(nproc),stat=err)
217  CALL check_allocate(err, 'NPOIN')
218  ALLOCATE(noq(nproc),stat=err)
219  CALL check_allocate(err, 'NOQ')
220  ALLOCATE(nseg(nproc),stat=err)
221  CALL check_allocate(err, 'NSEG')
222  ALLOCATE(mbnd(nproc),stat=err)
223  CALL check_allocate(err, 'MBND')
224  ALLOCATE(iklesa(3,nelem),stat=err)
225  CALL check_allocate(err, 'IKLESA')
226  ALLOCATE(nodenrs(npoin2),stat=err)
227  CALL check_allocate(err, 'NODENRS')
228  ALLOCATE(nptfrl(nproc),stat=err)
229  CALL check_allocate(err, 'NPTFR2LOC')
230 !
231  ALLOCATE(ifabor(nelem,3),stat=err)
232  CALL check_allocate(err, 'IFABOR')
233  ALLOCATE(ikle(nelem,3),stat=err)
234  CALL check_allocate(err, 'IKLE')
235  ALLOCATE(iadr(npoin2),stat=err)
236  CALL check_allocate(err, 'IADR')
237  ALLOCATE(nvois(npoin2),stat=err)
238  CALL check_allocate(err, 'NVOIS')
239  ALLOCATE(t3(npoin2),stat=err)
240  CALL check_allocate(err, 'T3')
241 !
242 ! END OF ALLOCATION ...
243 !
244 ! 6 : IKLE
245 !
246  READ(2) ((iklesa(i,j),i=1,ecken),j=1,nelem)
247 !
248 !----------------------------------------------------------------------
249 !
250 !
251  IF(nplan.LE.1) THEN
252  conlim = "T2DCLI"
253  ELSE
254  conlim = "T3DCLI"
255  ENDIF
256 !
257  OPEN(4,file=conlim,form='FORMATTED',err=996)
258  GO TO 997
259  996 WRITE(lu,*) 'ERROR WHEN OPENING FILE: ',conlim
260  CALL plante(1)
261  stop
262  997 CONTINUE
263 !
264  ALLOCATE(lihbor0(npoin2),stat=err)
265  CALL check_allocate(err, 'LIHBOR')
266  ALLOCATE(nbor0(npoin2),stat=err)
267  CALL check_allocate(err, 'NBOR')
268  DO i=1,npoin2
269  READ(4,*,end=989) lihbor0(i),idum,idum,rdum,rdum,rdum,rdum,
270  & idum,rdum,rdum,rdum,nbor0(i),idum
271  ENDDO
272 !
273  CLOSE(4)
274  989 nptfr=i-1
275 !
276  ALLOCATE(lihbor(nptfr),stat=err)
277  CALL check_allocate(err, 'LIHBOR')
278  ALLOCATE(nbor(nptfr),stat=err)
279  CALL check_allocate(err, 'NBOR')
280  ALLOCATE(nelbor(nptfr),stat=err)
281  CALL check_allocate(err, 'NELBOR')
282  ALLOCATE(nulone(nptfr,2),stat=err)
283  CALL check_allocate(err, 'NULONE')
284  ALLOCATE(kp1bor(nptfr,2),stat=err)
285  CALL check_allocate(err, 'KP1BOR')
286  ALLOCATE(iklbor(nptfr,2),stat=err)
287  CALL check_allocate(err, 'IKLBOR')
288  ALLOCATE(eltseg(nelem,3),stat=err)
289  CALL check_allocate(err, 'ELTSEG')
290  ALLOCATE(oriseg(nelem,3),stat=err)
291  CALL check_allocate(err, 'ORISEG')
292 !
293  mbnd2=0
294 !
295  DO i=1,npoin2
296  nodenrs(i) = i
297  ENDDO
298 !
299  DO i=1,nptfr
300  nbor(i) = nbor0(i)
301  lihbor(i) = lihbor0(i)
302  IF (lihbor(i).NE.2) THEN
303  mbnd2 = mbnd2 + 1
304  nodenrs(nbor(i)) = -mbnd2
305  ENDIF
306  ENDDO
307 !
308 !------------------------------------------------------------------------------
309 !
310 ! LOCAL CONSTRUCTION OF GLOSEG
311 !
312 !------------------------------------------------------------------------------
313 !
314 ! WITH PRISMS, DIFFERENT FROM 2D VALUES, OTHERWISE
315 !
316  ielm = 11 ! WARNING: IS HARD-CODED !!!
317  nelem2 =nelem
318  nelmax2 =nelem
319  nptfr2 =nptfr
320 !
321 ! NEIGHBOURS OF THE BOUNDARY SIDES FOR TRIANGULAR MESH
322 !
323  DO j=1,nelem
324  DO i=1,3
325  ikle(j,i)=iklesa(i,j)
326  ENDDO
327  ENDDO
328  ncsize = 1
329  IF(ielm.EQ.11.OR.ielm.EQ.41.OR.ielm.EQ.51) THEN
330  ! DUMMY ARRAY
331  ALLOCATE(nachb(1,1),stat=err)
332  CALL check_allocate(err, 'NACHB')
333 !
334  CALL voisin(ifabor,nelem2,nelem,ielm,ikle,
335  & nelem,
336  & npoin2,nachb,nbor,nptfr,iadr,nvois)
337 !
338  DEALLOCATE(nachb)
339  maxnvois = maxval(nvois)/2
340  ELSE
341  WRITE(lu,*) 'UNEXPECTED ELEMENT IN INBIEF:',ielm
342  CALL plante(1)
343  stop
344  ENDIF
345  klog = 2 ! SOLID BOUNDARY CONDITION: IS HARD-CODED !!!
346  IF(ielm.EQ.11.OR.ielm.EQ.41.OR.ielm.EQ.51) THEN
347  ! Dummy arrays
348  ALLOCATE(ifanum(1,1),stat=err)
349  CALL check_allocate(err, 'IFANUM')
350  ALLOCATE(isegf(nptfr),stat=err)
351  CALL check_allocate(err, 'ISEG')
352 !
353  CALL elebd(nelbor,nulone,kp1bor,
354  & ifabor,nbor,ikle,nelem,
355  & iklbor,nelem2,nelmax2,
356  & npoin2,nptfr2,ielm,
357  & lihbor,klog,
358  & isegf,
359  & iadr,nvois,t3,nptfr2,idum)
360 ! NELEBX,NELEB (HERE EQUAL TO NPTFR2)
361 ! NELEB IS INOUT => DUMMY
362  DEALLOCATE(ifanum)
363  DEALLOCATE(isegf)
364  ELSE
365  WRITE(lu,*) 'UNEXPECTED ELEMENT IN INBIEF:',ielm
366  CALL plante(1)
367  stop
368  ENDIF
369 !
370 !-----------------------------------------------------------------------
371 !
372 ! DATA STRUCTURE FOR EDGE-BASED STORAGE (FROM 5.9 ON ALWAYS DONE IN 2D)
373 ! SEE CALL TO COMP_SEG BELOW FOR COMPLETING THE STRUCTURE
374 !
375  IF(ielm.EQ.11) THEN
376 !
377  nseg2 = (3*nelem+nptfr)/2
378  noq2=nplan*(nseg2+mbnd2)+(nplan-1)*npoin2
379  IF(nplan.EQ.0) THEN
380  ALLOCATE(verif(nseg2+mbnd2),stat=err)
381  ELSE
382  ALLOCATE(verif(noq2) ,stat=err)
383  ENDIF
384  CALL check_allocate(err, 'VERIFSEG')
385 !
386 ! GLOBAL_VALUES, STORES THE WHOLE DATASET (NBV1-VALUES)
387  IF(nplan.EQ.0) THEN
388  ALLOCATE(global_value(nseg2+mbnd2),stat=err)
389  ELSE
390  ALLOCATE(global_value(noq2),stat=err)
391  ENDIF
392  CALL check_allocate(err, 'GLOBAL_VALUE')
393 !
394  ALLOCATE(gloseg(nseg2,2),stat=err)
395  CALL check_allocate(err, 'GLOSEG')
396 !
397  ! DUMMY ARRAY
398  ALLOCATE(knolg(1,1),stat=err)
399  CALL check_allocate(err, 'KNOLG')
400 
401  CALL stoseg(ifabor,nelem,nelmax2,nelmax2,ielm,ikle,
402  & nbor,nptfr,
403  & gloseg,nseg2, ! GLOSEG%MAXDIM1,
404  & eltseg,oriseg,nseg2,
405  & nelbor,nulone,knolg(:,1),iklbor,nptfr,nptfr)
406  DEALLOCATE(knolg)
407  ENDIF
408 !
409  ALLOCATE(segment(npoin2,maxnvois,2),stat=err)
410  CALL check_allocate(err, 'SEGMENT')
411 !
412 ! INITIALISES SEGMENT
413  DO k=1,2
414  DO j=1,maxnvois
415  DO i=1,npoin2
416  segment(i,j,k) = 0
417  ENDDO
418  ENDDO
419  ENDDO
420 !
421  DO iseg=1,nseg2
422  ig1 = gloseg(iseg,1)
423  ig2 = gloseg(iseg,2)
424 ! GLOBAL NUMBERS IN INCREASING ORDER
425  IF(ig1.GT.ig2) THEN
426  igtemp = ig1
427  ig1 = ig2
428  ig2 = igtemp
429  ENDIF
430  ivois=1
431  DO WHILE ((segment(ig1,ivois,1).NE.0).AND.(ivois.LE.maxnvois))
432  ivois = ivois + 1
433  ENDDO
434  segment(ig1,ivois,1) = ig2
435  segment(ig1,ivois,2) = iseg
436  ENDDO
437 !
438 ! OPENS FILES AND READS/SKIPS HEADERS -> NPOIN(NPROC), NPOINMAX
439 !
440  DO ipid = 0,nproc-1
441  fu = ipid +10
442  respar=res(1:i_len) // extens(nproc-1,ipid)
443  OPEN (fu,file=respar,form='UNFORMATTED',err=998)
444  GO TO 999
445 998 WRITE(lu,*) 'ERROR WHEN OPENING FILE: ',respar,
446  & ' USING FILE UNIT: ', fu
447  CALL plante(1)
448  stop
449 999 rewind(fu)
450  READ(fu) filetype
451  READ(fu) npoin(ipid+1)
452  READ(fu) nseg(ipid+1)
453  READ(fu) mbnd(ipid+1)
454  READ(fu) noq(ipid+1)
455  READ(fu) nplanloc
456  READ(fu) nptfrl(ipid+1)
457  END DO
458 !
459  npoinmax = maxval(npoin)
460  nsegmax = maxval(nseg)
461  noqmax = maxval(noq)
462  nptfrmax = maxval(nptfrl)
463 ! ARRAY FOR LOCAL-GLOBAL NUMBERS, 2D-FIELD
464  ALLOCATE (glosegloc(nsegmax,2,nproc),stat=err)
465  IF(nplan.EQ.0) THEN
466  ALLOCATE(knolg(npoinmax,nproc),stat=err)
467  ALLOCATE(kseglg(nsegmax,nproc),stat=err)
468  ALLOCATE(nodenrsloc(npoinmax,nproc),stat=err)
469  ALLOCATE(nborloc(nptfrmax,nproc),stat=err)
470  ALLOCATE(lihborloc(nptfrmax,nproc),stat=err)
471  ELSE
472  ALLOCATE(knolg(npoinmax/nplan,nproc),stat=err)
473  ALLOCATE(kseglg(noqmax,nproc),stat=err)
474  ALLOCATE(nodenrsloc(npoinmax/nplan,nproc),stat=err)
475  ALLOCATE(nborloc(nptfrmax,nproc),stat=err)
476  ALLOCATE(lihborloc(nptfrmax,nproc),stat=err)
477  ENDIF
478  CALL check_allocate(err, 'KNOLG')
479  CALL check_allocate(err, 'KSEGLG')
480  CALL check_allocate(err, 'NODENRSLOC')
481  CALL check_allocate(err, 'NBORLOC')
482 ! LOCAL_VALUES, STORES THE WHOLE DATASET (NBV1-VALUES)
483  ALLOCATE(local_value(noqmax),stat=err)
484  CALL check_allocate(err, 'LOCAL_VALUE')
485 !
486 ! READS KNOLG(NPOIN,NPROC)
487 !
488  IF(nplan.EQ.0) THEN
489  DO i=1,nseg2+mbnd2
490  verif(i)=0
491  ENDDO
492  ELSE
493  DO i=1,noq2
494  verif(i)=0
495  ENDDO
496  ENDIF
497 !
498  DO ipid = 0,nproc-1
499  fu = ipid +10
500 ! CHECKS
501  IF(nplan.EQ.0) THEN
502  READ(fu) (knolg(i,ipid+1),i=1,npoin(ipid+1))
503  READ(fu) ((glosegloc(i,j,ipid+1),j=1,2),i=1,nseg(ipid+1))
504  READ(fu) (nodenrsloc(i,ipid+1),i=1,npoin(ipid+1))
505  READ(fu) (nborloc(i,ipid+1),i=1,nptfrl(ipid+1))
506  READ(fu) (lihborloc(i,ipid+1),i=1,nptfrl(ipid+1))
507  ELSE
508  READ(fu) (knolg(i,ipid+1),i=1,npoin(ipid+1)/nplan)
509  READ(fu) ((glosegloc(i,j,ipid+1),j=1,2),i=1,nseg(ipid+1))
510  READ(fu) (nodenrsloc(i,ipid+1),i=1,npoin(ipid+1)/nplan)
511  READ(fu) (nborloc(i,ipid+1),i=1,nptfrl(ipid+1))
512  READ(fu) (lihborloc(i,ipid+1),i=1,nptfrl(ipid+1))
513  ENDIF
514 !
515 ! INITIALISES SEGMENT
516 !
517  DO iseg=1,nseg(ipid+1)
518  il1 = glosegloc(iseg,1,ipid+1)
519  il2 = glosegloc(iseg,2,ipid+1)
520  ig1 = knolg(il1,ipid+1)
521  ig2 = knolg(il2,ipid+1)
522 ! GLOBAL NUMBER IN INCREASING ORDER
523  IF(ig1.GT.ig2) THEN
524  igtemp = ig1
525  ig1 = ig2
526  ig2 = igtemp
527  ENDIF
528  ivois=1
529  DO WHILE ((segment(ig1,ivois,1).NE.ig2)
530  & .AND.(ivois.LE.maxnvois))
531  ivois = ivois + 1
532  ENDDO
533  IF(ivois.LE.maxnvois) THEN
534  kseglg(iseg,ipid+1) = segment(ig1,ivois,2)
535  ENDIF
536  ENDDO
537 !
538  ENDDO
539 !
540 ! FURTHER VERIFICATIONS
541 !
542 ! READS DATASETS
543 !
544  nresu = 0
545 !
546 2000 nresu = nresu + 1
547 !
548  IF(nplan.EQ.0) THEN
549  DO i=1,nseg2+mbnd2
550  verif(i)=0
551  ENDDO
552  ELSE
553  DO i=1,noq2
554  verif(i)=0
555  ENDDO
556  ENDIF
557 !
558  WRITE(lu,*)'TRY TO READ DATASET NO.',nresu
559 !
560  IF(nplan.EQ.0) THEN
561  DO i=1,nseg2+mbnd2
562  global_value(i) = 0.d0
563  ENDDO
564  ELSE
565  DO i=1,noq2
566  global_value(i) = 0.d0
567  ENDDO
568  ENDIF
569 !
570  DO ipid = 0,nproc-1
571  fu = ipid +10
572 ! READS LOCAL X INSTEAD OF GREDELSEG_READ_DATASET
573  CALL gredelpts_read_dataset
574  & (local_value,noqmax,noq(ipid+1),it,fu,ende)
575  IF (ende) GOTO 3000
576 ! STORES EACH DATASET
577  IF(nplan.EQ.0) THEN
578  nseg2loc = nseg(ipid+1)
579  nptfrloc = nptfrl(ipid+1)
580  DO i=1,nseg2loc
581  global_value(kseglg(i,ipid+1)) =
582  & global_value(kseglg(i,ipid+1)) + local_value(i)
583  verif(kseglg(i,ipid+1)) = verif(kseglg(i,ipid+1))
584  & + 1
585  ENDDO
586 !
587  DO i=1,nptfrloc
588  IF(lihborloc(i,ipid+1).NE.2) THEN
589  IF(filetype(1:7).EQ.'SUMAREA') THEN
590  global_value(-nodenrs(knolg(nborloc(i,ipid+1),ipid+1))
591  & + nseg2) =
592  & local_value(-nodenrsloc(nborloc(i,ipid+1),ipid+1)
593  & + nseg2loc)
594  verif( -nodenrs(knolg(nborloc(i,ipid+1),ipid+1))
595  & + nseg2) = 1
596  ELSEIF(filetype(1:7).EQ.'SUMFLOW') THEN
597  global_value(-nodenrs(knolg(nborloc(i,ipid+1),ipid+1))
598  & + nseg2) =
599  & global_value(-nodenrs(knolg(nborloc(i,ipid+1),ipid+1))
600  & + nseg2) +
601  & local_value(-nodenrsloc(nborloc(i,ipid+1),ipid+1)
602  & + nseg2loc)
603  verif( -nodenrs(knolg(nborloc(i,ipid+1),ipid+1))
604  & + nseg2) =
605  & verif( -nodenrs(knolg(nborloc(i,ipid+1),ipid+1))
606  & + nseg2) + 1
607  ELSE
608  WRITE(lu,*) 'CAS NON PREVU'
609  CALL plante(1)
610  stop
611  ENDIF
612  ENDIF
613  ENDDO
614 !
615  ELSE
616  npoin2loc = npoin(ipid+1)/nplan
617  nseg2loc = nseg(ipid+1)
618  mbndloc = mbnd(ipid+1)
619  nptfrloc = nptfrl(ipid+1)
620  DO i=1,nseg2loc
621  DO j=1,nplan
622  global_value(kseglg(i,ipid+1) + (nseg2+mbnd2)*(j-1)) =
623  & global_value(kseglg(i,ipid+1) + (nseg2+mbnd2)*(j-1)) +
624  & local_value( i + (nseg2loc+mbndloc)*(j-1))
625  verif(kseglg(i,ipid+1) + (nseg2+mbnd2)*(j-1)) =
626  & + verif(kseglg(i,ipid+1) + (nseg2+mbnd2)*(j-1)) + 1
627  END DO
628  END DO
629 !
630  DO i=1,nptfrloc
631  IF(lihborloc(i,ipid+1).NE.2) THEN
632  DO j=1,nplan
633  IF(filetype(1:7).EQ.'SUMAREA') THEN
634  global_value(-nodenrs(knolg(nborloc(i,ipid+1),ipid+1))
635  & + nseg2 + (nseg2+mbnd2)*(j-1)) =
636  & local_value(-nodenrsloc(nborloc(i,ipid+1),ipid+1)
637  & + nseg2loc + (nseg2loc+mbndloc)*(j-1))
638  verif( -nodenrs(knolg(nborloc(i,ipid+1),ipid+1))
639  & + nseg2 + (nseg2+mbnd2)*(j-1)) = 1
640  ELSEIF(filetype(1:7).EQ.'SUMFLOW') THEN
641  global_value(-nodenrs(knolg(nborloc(i,ipid+1),ipid+1))
642  & + nseg2 + (nseg2+mbnd2)*(j-1)) =
643  & global_value(-nodenrs(knolg(nborloc(i,ipid+1),ipid+1))
644  & + nseg2 + (nseg2+mbnd2)*(j-1)) +
645  & local_value(-nodenrsloc(nborloc(i,ipid+1),ipid+1)
646  & + nseg2loc + (nseg2loc+mbndloc)*(j-1))
647  verif( -nodenrs(knolg(nborloc(i,ipid+1),ipid+1))
648  & + nseg2 + (nseg2+mbnd2)*(j-1)) =
649  & verif( -nodenrs(knolg(nborloc(i,ipid+1),ipid+1))
650  & + nseg2 + (nseg2+mbnd2)*(j-1)) + 1
651  ELSE
652  WRITE(lu,*) 'CAS NON PREVU'
653  CALL plante(1)
654  stop
655  ENDIF
656  ENDDO
657  ENDIF
658  ENDDO
659 !
660  DO i=1,npoin2loc
661  DO j=1,nplan-1
662  IF(filetype(1:7).EQ.'SUMAREA') THEN
663  global_value( knolg(i,ipid+1) + npoin2*(j-1)
664  & + (nseg2+mbnd2)*nplan) =
665  & local_value(i+npoin2loc*(j-1)+(nseg2loc+mbndloc)*nplan)
666  verif( knolg(i,ipid+1) + npoin2*(j-1)
667  & + (nseg2+mbnd2)*nplan) = 1
668  ELSEIF(filetype(1:7).EQ.'SUMFLOW') THEN
669  global_value( knolg(i,ipid+1) + npoin2*(j-1)
670  & + (nseg2+mbnd2)*nplan) =
671  & global_value( knolg(i,ipid+1) + npoin2*(j-1)
672  & + (nseg2+mbnd2)*nplan) +
673  & local_value(i+npoin2loc*(j-1)+(nseg2loc+mbndloc)*nplan)
674  verif( knolg(i,ipid+1) + npoin2*(j-1)
675  & + (nseg2+mbnd2)*nplan) =
676  & verif( knolg(i,ipid+1) + npoin2*(j-1)
677  & + (nseg2+mbnd2)*nplan) + 1
678  ELSE
679  WRITE(lu,*) 'CAS NON PREVU'
680  CALL plante(1)
681  stop
682  ENDIF
683  ENDDO
684  ENDDO
685  ENDIF
686  ENDDO
687 ! WRITES GLOBAL DATASET
688  WRITE(lu,*)'WRITING DATASET NO.',nresu,' TIME =',it
689 !
690  IF(nplan.EQ.0) THEN
691  WRITE(3) it, (global_value(i),i=1,nseg2+mbnd2)
692  ELSE
693  WRITE(3) it, (global_value(i),i=1,noq2)
694  ENDIF
695 ! CHECKS ...
696  IF(nplan.EQ.0) THEN
697  DO i=1,nseg2+mbnd2
698  IF(verif(i).EQ.0) THEN
699  WRITE(lu,*) 'ERROR, SEGMENT I=',i,' FALSE FOR NRESU=',nresu
700  ENDIF
701  ENDDO
702  ELSE
703  DO i=1,noq2
704  IF(verif(i).EQ.0) THEN
705  WRITE(lu,*) 'ERROR, SEGMENT I=',i,' FALSE FOR NRESU=',nresu
706  ENDIF
707  ENDDO
708  ENDIF
709 !
710  GO TO 2000
711 !
712 3000 WRITE(lu,*) 'END OF PROGRAM, ',nresu-1,' DATASETS FOUND'
713 !
714  CLOSE(2)
715  CLOSE(3)
716 !
717  DO ipid = 0,nproc-1
718  fu = ipid +10
719  CLOSE (fu)
720  ENDDO
721 !
722  stop 0
723  END PROGRAM gredelseg_autop
declarations_special
Definition: declarations_special.F:3
declarations_special::lng
integer lng
Definition: declarations_special.F:40
declarations_special::lu
integer lu
Definition: declarations_special.F:45
declarations_special::li
integer li
Definition: declarations_special.F:46
gredelpts_read_dataset
subroutine gredelpts_read_dataset(LOCAL_VALUE, NPOINMAX, NPOIN, IT, FU, ENDE)
Definition: gredelpts_read_dataset.f:6
gredelseg_autop
program gredelseg_autop
Definition: gredelseg_autop.f:3
voisin
subroutine voisin(IFABOR, NELEM, NELMAX, IELM, IKLE, SIZIKL, NPOIN, NACHB, NBOR, NPTFR, IADR, NVOIS)
Definition: voisin.f:8
stoseg
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
elebd
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
bief
Definition: bief.f:3
Generated on Tue Jan 5 2021 14:38:04 for The TELEMAC-MASCARET system by doxygen 1.8.13