The TELEMAC-MASCARET system  trunk
gredelhyd_autop.f
Go to the documentation of this file.
1 ! ***********************
2  PROGRAM gredelhyd_autop
3 ! ***********************
4 !
5 !
6 !***********************************************************************
7 ! PARALLEL V6P2 21/08/2010
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 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
41 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
42 !
43  USE declarations_special
44  IMPLICIT NONE
45 !
46  CHARACTER(LEN=30) GEO
47 !
48  INTEGER ERR,NELEM,ECKEN,NDUM,I,J,NBV1,NBV2,PARAM(10)
49  INTEGER NPLAN,NPOIN2,NPROC,I_S,I_SP,I_LEN,IDUM,NPTFR,NSEG2,MBND
50  INTEGER IYEAR,IMONTH,IDAY,IHOUR,IMIN,ISEC
51 !
52  INTEGER, DIMENSION(:) , ALLOCATABLE :: LIHBOR ! LIHBOR(NPTFR)
53  INTEGER, DIMENSION(:) , ALLOCATABLE :: NBOR ! NBOR(*)
54  INTEGER, DIMENSION(:) , ALLOCATABLE :: NBOR0,LIHBOR0 ! NBOR0(NPTFR),LIHBOR0(NPTFR)
55 !
56  REAL RDUM
57  REAL, DIMENSION(:) , ALLOCATABLE :: F
58 !
59  DOUBLE PRECISION REFER_DAY,JULIAN_DAY
60  DOUBLE PRECISION JULTIM
61  EXTERNAL jultim
62 !
63  LOGICAL IS
64 !
65  CHARACTER(LEN=30) RES
66  CHARACTER(LEN=50) RESPAR
67  CHARACTER(LEN=11) EXTENS
68  CHARACTER(LEN=30) CONLIM
69  EXTERNAL extens
70 !
71  INTEGER ITSTRT,ITSTOP,NSTEPA
72  INTEGER MARDAT(3),MARTIM(3)
73  CHARACTER(LEN=PATH_LEN) TITRE
74  CHARACTER(LEN=PATH_LEN) NOMGEO,NOMLIM
75  CHARACTER(LEN=PATH_LEN) NOMSOU,NOMMAB,NOMCOU,NOMSAL,NOMTEM
76  CHARACTER(LEN=PATH_LEN) NOMINI,NOMVEB,NOMMAF,NOMVEL,NOMVIS
77  LOGICAL SALI_DEL,TEMP_DEL
78  LOGICAL VELO_DEL,DIFF_DEL
79 !
80  li=5
81  lu=6
82  lng=2
83 !HW
84 !JAJ INTRODUCE YOURSELF WITH THE RELEASE DATE
85 !
86  WRITE(lu,*) 'I AM GREDELHYD, COUSIN OF GRETEL FROM BAW HAMBURG'
87  WRITE(lu,*)
88 !
89  WRITE (lu, advance='NO',
90  & fmt='(/,'' GLOBAL GEOMETRY FILE: '')')
91 ! REWIND(LI)
92  READ(li,*) geo
93  WRITE(lu,*) geo
94 !
95 ! READS FILENAMES AND THE NUMBER OF PROCESSORS / PARTITIONS
96 !
97  WRITE (lu, advance='NO', fmt='(/,'' RESULT FILE: '')')
98  READ(li,*) res
99  WRITE(lu,*) res
100 !
101  WRITE (lu,advance='NO',fmt='(/,'' NUMBER OF PROCESSORS: '')')
102  READ (li,*) nproc
103  WRITE(lu,*) nproc
104  INQUIRE (file=geo,exist=is)
105  IF (.NOT.is) THEN
106  WRITE (lu,*) 'FILE DOES NOT EXIST: ', geo
107  CALL plante(1)
108  stop
109  END IF
110 !
111  i_s = len(res)
112  i_sp = i_s + 1
113  DO i=1,i_s
114  IF(res(i_sp-i:i_sp-i) .NE. ' ') EXIT
115  ENDDO
116  i_len=i_sp - i
117 !
118 ! GEOMETRY FILE, READ UNTIL 10 PARAMETERS:
119 !
120  OPEN(2,file=geo,form='UNFORMATTED',status='OLD',err=990)
121  READ(2,err=990)
122  READ(2,err=990) nbv1,nbv2
123  DO i=1,nbv1+nbv2
124  READ(2,err=990)
125  ENDDO ! I
126  GO TO 992
127 990 WRITE(lu,*) 'ERROR WHEN OPENING OR READING FILE: ',geo
128  CALL plante(1)
129  stop
130 992 CONTINUE
131 ! READS THE 10 PARAMETERS AND THE DATE
132  READ(2) (param(i),i=1,10)
133  IF(param(10).EQ.1) READ(2) (param(i),i=1,6)
134 !
135 ! RESULTS FILE:
136 !
137  OPEN(3,file=res,form='FORMATTED',err=991)
138  GO TO 993
139 991 WRITE(lu,*) 'ERROR WHEN OPENING FILE: ',res
140  CALL plante(1)
141  stop
142 993 CONTINUE
143 !
144 ! 1) READS THE BEGINNING OF THE FIRST RESULTS FILE
145 !
146 !CC RESPAR=RES // EXTENS(2**IDIMS-1,0)
147 !
148  respar=res(1:i_len) // extens(nproc-1,0)
149 !
150  INQUIRE (file=respar,exist=is)
151  IF (.NOT.is) THEN
152  WRITE (lu,*) 'FILE DOES NOT EXIST: ', respar
153  WRITE (lu,*) 'CHECK THE NUMBER OF PROCESSORS'
154  WRITE (lu,*) 'AND THE RESULT FILE CORE NAME'
155  CALL plante(1)
156  stop
157  END IF
158 !
159  OPEN(4,file=respar,form='FORMATTED',err=994)
160  GO TO 995
161 994 WRITE(lu,*) 'ERROR WHEN OPENING FILE: ',respar
162  CALL plante(1)
163  stop
164 995 CONTINUE
165 !
166  READ(4,'(I6)')nplan
167  CLOSE(4)
168 !
169  ALLOCATE(f(nplan),stat=err)
170  CALL check_allocate(err, 'F')
171 !
172 ! 5 : 4 PARAMETERS
173 !
174  READ(2) nelem,npoin2,ecken,ndum
175  WRITE(lu,*) '4 PARAMETERS IN GEOMETRY FILE'
176  WRITE(lu,*) 'NELEM=', nelem
177  WRITE(lu,*) 'NPOIN2=', npoin2
178  WRITE(lu,*) 'ECKEN=', ecken
179  WRITE(lu,*) 'NDUM=', ndum
180 !
181 !----------------------------------------------------------------------
182 !
183  IF(nplan.LE.1) THEN
184  conlim = "T2DCLI"
185  ELSE
186  conlim = "T3DCLI"
187  ENDIF
188 !
189  OPEN(4,file=conlim,form='FORMATTED',err=996)
190  GO TO 997
191  996 WRITE(lu,*) 'ERROR WHEN OPENING FILE: ',conlim
192  CALL plante(1)
193  stop
194  997 CONTINUE
195 !
196  ALLOCATE(lihbor0(npoin2),stat=err)
197  CALL check_allocate(err, 'LIHBOR')
198  ALLOCATE(nbor0(npoin2),stat=err)
199  CALL check_allocate(err, 'NBOR')
200  DO i=1,npoin2
201  READ(4,*,end=989) lihbor0(i),idum,idum,rdum,rdum,rdum,rdum,
202  & idum,rdum,rdum,rdum,nbor0(i),idum
203  ENDDO
204 !
205  CLOSE(4)
206  989 nptfr=i-1
207 !
208  ALLOCATE(lihbor(nptfr),stat=err)
209  CALL check_allocate(err, 'LIHBOR')
210  ALLOCATE(nbor(nptfr),stat=err)
211  CALL check_allocate(err, 'NBOR')
212 !
213  mbnd=0
214 !
215  DO i=1,nptfr
216  nbor(i) = nbor0(i)
217  lihbor(i) = lihbor0(i)
218  IF (lihbor(i).NE.2) THEN
219  mbnd = mbnd + 1
220  ENDIF
221  ENDDO
222 !
223 ! WITH PRISMS, DIFFERENT FROM 2D VALUES, OTHERWISE
224 !
225  nseg2 = (3*nelem+nptfr)/2
226 !
227 !
228  OPEN(4,file=respar,form='FORMATTED',err=984)
229  GO TO 985
230 984 WRITE(lu,*) 'ERROR WHEN OPENING FILE: ',respar
231  CALL plante(1)
232  stop
233 985 CONTINUE
234 !
235  READ(4,'(I6)')nplan
236  READ(4,'(I3)')j
237  READ(4,'(A)')titre(1:j)
238  READ(4,'(I4)')mardat(1)
239  READ(4,'(I2)')mardat(2)
240  READ(4,'(I2)')mardat(3)
241  READ(4,'(I2)')martim(1)
242  READ(4,'(I2)')martim(2)
243  READ(4,'(I2)')martim(3)
244  READ(4,'(I14)')itstrt
245  READ(4,'(I14)')itstop
246  READ(4,'(I14)')nstepa
247  READ(4,'(I6)')nplan
248 !
249  WRITE(3, '(A)' )
250  & "task full-coupling "
251  WRITE(3, '(A)' )
252  & " "
253  WRITE(3, '(A)' )
254  & "# "
255  WRITE(3, '(A)' )
256  & "# telemac data "
257  WRITE(3, '(A)' )
258  & "# "
259  WRITE(3, '(A)' )
260  & " "
261  WRITE(3, '(A)' )
262  & "geometry finite-elements "
263  WRITE(3, '(A)' )
264  & " "
265  WRITE(3, '(A)' )
266  & "horizontal-aggregation no "
267  WRITE(3, '(A)' )
268  & "minimum-vert-diffusion-used no "
269  WRITE(3, '(A)' )
270  & "vertical-diffusion calculated "
271  WRITE(3, '(A)' )
272  & "description "
273 ! J = LEN_TRIM(TITRE)
274  IF ( j .GT. 40 ) THEN
275  WRITE (3, '(A,A,A)' ) " '",titre(1:40),"'"
276  IF ( j .GT. 80 ) THEN
277  WRITE (3, '(A,A,A)' ) " '",titre(41:80),"'"
278  IF ( j .GT. 120 ) THEN
279  WRITE (3, '(A,A,A)' ) " '",titre(81:120),"'"
280  ELSE
281  WRITE (3, '(A,A,A)' ) " '",titre(81:j),"'"
282  ENDIF
283  ELSE
284  WRITE (3, '(A,A,A)' ) " '",titre(41:j),"'"
285  WRITE (3, '(A)' )
286  & " ' ' "
287  ENDIF
288  ELSE
289  WRITE (3, '(A,A,A)' ) " '",titre(1:j),"'"
290  WRITE (3, '(A)' )
291  & " ' ' "
292  WRITE (3, '(A)' )
293  & " ' ' "
294  ENDIF
295 ! WRITE(3, '(A,A,A)' )
296 ! & " '",TITRE(1:J),"'"
297 ! WRITE(3, '(A)' )
298 ! & " ' ' "
299 ! WRITE(3, '(A)' )
300 ! & " ' ' "
301  WRITE(3, '(A)' )
302  & "end-description "
303  WRITE(3, '(A,I4.4,I2.2,I2.2,I2.2,I2.2,I2.2,A)' )
304  &"reference-time '",mardat(1),mardat(2),mardat(3),
305  & martim(1),martim(2),martim(3),"'"
306  refer_day = jultim(mardat(1),mardat(2),mardat(3),
307  & martim(1),martim(2),martim(3),0.d0)
308  julian_day = refer_day + dble(itstrt)/(86400.d0*36525.d0)
309  CALL gregtim( julian_day, iyear, imonth, iday,
310  & ihour, imin, isec )
311  WRITE(3, '(A,I4.4,I2.2,I2.2,I2.2,I2.2,I2.2,A)' )
312  & "hydrodynamic-start-time '",iyear,imonth,iday,
313  & ihour,imin ,isec, "'"
314  julian_day = refer_day + dble(itstop)/(86400.d0*36525.d0)
315  CALL gregtim( julian_day, iyear, imonth, iday,
316  & ihour, imin, isec )
317  WRITE(3, '(A,I4.4,I2.2,I2.2,I2.2,I2.2,I2.2,A)' )
318  & "hydrodynamic-stop-time '",iyear,imonth,iday,
319  & ihour,imin ,isec, "'"
320  WRITE(3, '(A,I14,A)' )
321  & "hydrodynamic-timestep '",nstepa,"'"
322  WRITE(3, '(A,I4.4,I2.2,I2.2,I2.2,I2.2,I2.2,A)' )
323  & "conversion-ref-time '",mardat(1),mardat(2),mardat(3),
324  & martim(1),martim(2),martim(3),"'"
325  julian_day = refer_day + dble(itstrt)/(86400.d0*36525.d0)
326  CALL gregtim( julian_day, iyear, imonth, iday,
327  & ihour, imin, isec )
328  WRITE(3, '(A,I4.4,I2.2,I2.2,I2.2,I2.2,I2.2,A)' )
329  & "conversion-start-time '",iyear,imonth,iday,
330  & ihour,imin ,isec, "'"
331  julian_day = refer_day + dble(itstop)/(86400.d0*36525.d0)
332  CALL gregtim( julian_day, iyear, imonth, iday,
333  & ihour, imin, isec )
334  WRITE(3, '(A,I4.4,I2.2,I2.2,I2.2,I2.2,I2.2,A)' )
335  & "conversion-stop-time '",iyear,imonth,iday,
336  & ihour,imin ,isec, "'"
337  WRITE(3, '(A,I14,A)' )
338  & "conversion-timestep '",nstepa,"'"
339  WRITE(3, '(A,I7)' )
340  & "grid-cells-first-direction ",npoin2
341  WRITE(3, '(A,I7,A)')
342  & "grid-cells-second-direction ",nseg2+mbnd," # nr of exchanges!"
343  WRITE(3, '(A,I6)' )
344  & "number-hydrodynamic-layers ",nplan
345  WRITE(3, '(A,I6)' )
346  & "number-water-quality-layers",nplan
347  READ(4,'(I3)')j
348  READ(4,'(A)')nomgeo(1:j)
349  WRITE(3, '(A,A,A)' )
350  & "hydrodynamic-file '",nomgeo(1:j),"'"
351  WRITE(3, '(A)' )
352  & "aggregation-file none "
353  WRITE(3, '(A,A,A)' )
354  & "grid-indices-file '",nomgeo(1:j),"'"
355  READ(4,'(I3)')j
356  READ(4,'(A)')nomlim(1:j)
357  WRITE(3, '(A,A,A)' )
358  & "grid-coordinates-file '",nomlim(1:j),"'"
359  READ(4,'(I3)')j
360  READ(4,'(A)') nomsou(1:j)
361  i = j
362  DO WHILE(i.GE.1)
363  IF((nomsou(i:i).NE.'/').AND.(nomsou(i:i).NE.'\')) THEN
364  I = I-1
365  ELSE
366  EXIT
367  ENDIF
368  ENDDO
369  WRITE(3, '(a,a,a)' )
370  & "volumes-file '",NOMSOU(I+1:J),"'"
371  READ(4,'(i3)')J
372  READ(4,'(a)') NOMMAB(1:J)
373  I = J
374 .GE. DO WHILE(I1)
375 .NE. IF((NOMMAB(I:I)'/.AND..NE.')(NOMMAB(I:I)')) THEN
376  i = i-1
377  ELSE
378  EXIT
379  ENDIF
380  ENDDO
381  WRITE(3, '(A,A,A)' )
382  & "areas-file '",nommab(i+1:j),"'"
383  READ(4,'(I3)')j
384  READ(4,'(A)') nomcou(1:j)
385  i = j
386  DO WHILE(i.GE.1)
387  IF((nomcou(i:i).NE.'/').AND.(nomcou(i:i).NE.'\')) THEN
388  I = I-1
389  ELSE
390  EXIT
391  ENDIF
392  ENDDO
393  WRITE(3, '(a,a,a)' )
394  & "flows-file '",NOMCOU(I+1:J),"'"
395  READ(4,'(i3)')J
396  READ(4,'(a)') NOMVEB(1:J)
397  I = J
398 .GE. DO WHILE(I1)
399 .NE. IF((NOMVEB(I:I)'/.AND..NE.')(NOMVEB(I:I)')) THEN
400  i = i-1
401  ELSE
402  EXIT
403  ENDIF
404  ENDDO
405  WRITE(3, '(A,A,A)' )
406  & "pointers-file '",nomveb(i+1:j),"'"
407  READ(4,'(I3)')j
408  READ(4,'(A)')nommaf(1:j)
409  i = j
410  DO WHILE(i.GE.1)
411  IF((nommaf(i:i).NE.'/').AND.(nommaf(i:i).NE.'\')) THEN
412  I = I-1
413  ELSE
414  EXIT
415  ENDIF
416  ENDDO
417  WRITE(3, '(a,a,a)' )
418  & "lengths-file '",NOMMAF(I+1:J),"'"
419  READ(4,'(l1)') SALI_DEL
420  IF(SALI_DEL) THEN
421  READ(4,'(i3)')J
422  READ(4,'(a)') NOMSAL(1:J)
423  I = J
424 .GE. DO WHILE(I1)
425 .NE. IF((NOMSAL(I:I)'/.AND..NE.')(NOMSAL(I:I)')) THEN
426  i = i-1
427  ELSE
428  EXIT
429  ENDIF
430  ENDDO
431  WRITE(3, '(A,A,A)' )
432  & "salinity-file '",nomsal(i+1:j),"'"
433  ELSE
434  WRITE(3, '(A)' )
435  & "salinity-file none "
436  ENDIF
437  READ(4,'(L1)') temp_del
438  IF(temp_del) THEN
439  READ(4,'(I3)')j
440  READ(4,'(A)') nomtem(1:j)
441  i = j
442  DO WHILE(i.GE.1)
443  IF((nomtem(i:i).NE.'/').AND.(nomtem(i:i).NE.'\')) THEN
444  I = I-1
445  ELSE
446  EXIT
447  ENDIF
448  ENDDO
449  WRITE(3, '(a,a,a)' )
450  & "temperature-file '",NOMTEM(I+1:J),"'"
451  ELSE
452  WRITE(3, '(a)' )
453  & "temperature-file none "
454  ENDIF
455  READ(4,'(l1)') DIFF_DEL
456  IF(DIFF_DEL) THEN
457  READ(4,'(i3)')J
458  READ(4,'(a)') NOMVIS(1:J)
459  I = J
460 .GE. DO WHILE(I1)
461 .NE. IF((NOMVIS(I:I)'/.AND..NE.')(NOMVIS(I:I)')) THEN
462  i = i-1
463  ELSE
464  EXIT
465  ENDIF
466  ENDDO
467  WRITE(3, '(A,A,A)' )
468  & "vert-diffusion-file '",nomvis(i+1:j),"'"
469  ELSE
470  WRITE(3, '(A)' )
471  & "vert-diffusion-file none "
472  ENDIF
473  READ(4,'(L1)') velo_del
474  IF(velo_del) THEN
475  READ(4,'(I3)')j
476  READ(4,'(A)') nomvel(1:j)
477  i = j
478  DO WHILE(i.GE.1)
479  IF((nomvel(i:i).NE.'/').AND.(nomvel(i:i).NE.'\')) THEN
480  I = I-1
481  ELSE
482  EXIT
483  ENDIF
484  ENDDO
485  WRITE(3, '(a,a,a)' )
486  & "velocity-file '",NOMVEL(I+1:J),"'"
487  ELSE
488  WRITE(3, '(a)' )
489  & "velocity-file none "
490  ENDIF
491  READ(4,'(i3)')J
492  READ(4,'(a)') NOMINI(1:J)
493  I = J
494 .GE. DO WHILE(I1)
495 .NE. IF((NOMINI(I:I)'/.AND..NE.')(NOMINI(I:I)')) THEN
496  i = i-1
497  ELSE
498  EXIT
499  ENDIF
500  ENDDO
501  WRITE(3, '(A,A,A)' )
502  & "surfaces-file '",nomini(i+1:j),"'"
503 !
504  WRITE(3, '(A)' )
505  & "total-grid-file none "
506  WRITE(3, '(A)' )
507  & "discharges-file none "
508  WRITE(3, '(A)' )
509  & "chezy-coefficients-file none "
510  WRITE(3, '(A)' )
511  & "shear-stresses-file none "
512  WRITE(3, '(A)' )
513  & "walking-discharges-file none "
514  IF ( nplan .GT. 1 ) THEN
515  WRITE(3, '(A)' )
516  & "minimum-vert-diffusion "
517  WRITE(3, '(A)' )
518  & " upper-layer 0.0000E+00 "
519  WRITE(3, '(A)' )
520  & " lower-layer 0.0000E+00 "
521  WRITE(3, '(A)' )
522  & " interface-depth 0.0000E+00 "
523  WRITE(3, '(A)' )
524  & "end-minimum-vert-diffusion "
525  ENDIF
526  WRITE(3, '(A)' )
527  & "constant-dispersion "
528  WRITE(3, '(A)' )
529  & " first-direction 0.0000 "
530  WRITE(3, '(A)' )
531  & " second-direction 0.0000 "
532  WRITE(3, '(A)' )
533  & " third-direction 0.0000 "
534  WRITE(3, '(A)' )
535  & "end-constant-dispersion "
536  WRITE(3, '(A)' )
537  & "hydrodynamic-layers "
538  DO i=1,nplan
539  READ(4,'(F10.4)')f(i)
540  ENDDO
541  DO i=1,nplan
542  WRITE(3, '(F10.4)' ) f(i)
543  ENDDO
544  WRITE(3, '(A)' )
545  & "end-hydrodynamic-layers "
546  WRITE(3, '(A)' )
547  & "water-quality-layers "
548  DO i=1,nplan
549  WRITE(3, '(F10.4)' ) 1.0
550  ENDDO
551  WRITE(3, '(A)' )
552  & "end-water-quality-layers "
553  WRITE(3, '(A)' )
554  & "discharges "
555  WRITE(3, '(A)' )
556  & "end-discharges "
557 !
558  WRITE(lu,*) 'END OF PROGRAM '
559 !
560  CLOSE(2)
561  CLOSE(3)
562  CLOSE(4)
563 !
564  stop 0
565  END PROGRAM gredelhyd_autop
declarations_special
Definition: declarations_special.F:3
declarations_special::lng
integer lng
Definition: declarations_special.F:40
gregtim
subroutine gregtim(JULTIM, YEAR, MONTH, DAY, HOUR, MINU, SEC)
Definition: gregtim.f:7
declarations_special::lu
integer lu
Definition: declarations_special.F:45
declarations_special::li
integer li
Definition: declarations_special.F:46
gredelhyd_autop
program gredelhyd_autop
Definition: gredelhyd_autop.f:3
Generated on Tue Jan 5 2021 14:38:03 for The TELEMAC-MASCARET system by doxygen 1.8.13