The TELEMAC-MASCARET system  trunk
fluxpr_gaia.f
Go to the documentation of this file.
1 ! *************************
2  SUBROUTINE fluxpr_gaia
3 ! *************************
4 !
5  &(nsec,ctrlsc,flx,volneg,volpos,info,tps,nseg,ncsize,
6  & flxs,volnegs,volposs,susp,flxc,volnegc,volposc,charr)
7 !
8 !***********************************************************************
9 ! GAIA V7P0 21/07/2011
10 !***********************************************************************
11 !
14 !
18 !
19 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
37 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
38 !
39  USE bief_def, ONLY: ipid
41  & init_fluxpr,work,workb
44  IMPLICIT NONE
45 !
46 !!-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
47 !
48  INTEGER, INTENT(IN) :: NSEC,NCSIZE
49  INTEGER, INTENT(IN) :: CTRLSC(*)
50  INTEGER, INTENT(IN) :: NSEG(nsec)
51  LOGICAL, INTENT(IN) :: INFO,SUSP,CHARR
52  DOUBLE PRECISION, INTENT(IN) :: FLX(nsec),TPS
53  DOUBLE PRECISION, INTENT(IN) :: VOLNEG(nsec),VOLPOS(nsec)
54  DOUBLE PRECISION, INTENT(IN) :: FLXS(nsec),FLXC(nsec)
55  DOUBLE PRECISION, INTENT(IN) :: VOLNEGS(nsec),VOLPOSS(nsec)
56  DOUBLE PRECISION, INTENT(IN) :: VOLNEGC(nsec),VOLPOSC(nsec)
57 !
58 !!-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
59 !
60  INTEGER ISEC,II,ERR,NSEO
61  CHARACTER(LEN=16) :: FMTZON='(4(1X,1PG21.14))'
62  LOGICAL :: OLD_METHOD=.false.
63 !##>JR @ ADJOINTWARE: ALGORITHMIC DIFFERENTIATION
64  DOUBLE PRECISION :: DTMP1,DTMP2,DTMP3,DTMP4
65 !##<JR @ ADJOINTWARE
66 !
67 !-----------------------------------------------------------------------
68 !
69  nseo=gai_files(gaiseo)%LU
70 !
71 !-----------------------------------------------------------------------
72 !
73  IF(.NOT.ALLOCATED(chain)) old_method=.true.
74 !
75 ! DONE ONCE FOR ALL
76 !
77  IF(init_fluxpr.AND.(trim(gai_files(gaiseo)%NAME).NE.'') ) THEN
78 !
79  IF(ncsize.GT.1) THEN
80  ALLOCATE (work(nsec), stat=err)
81  IF(err.NE.0) THEN
82  WRITE(lu,*) 'FLUXPR_GAIA: ERROR ALLOCATING WORK:',err
83  CALL plante(1)
84  stop
85  ENDIF
86  IF(charr.AND.susp) THEN
87  ALLOCATE (workb(nsec), stat=err)
88  IF(err.NE.0) THEN
89  WRITE(lu,*) 'FLUXPR_GAIA: ERROR ALLOCATING WORK:',err
90  CALL plante(1)
91  stop
92  ENDIF
93  ENDIF
94  ENDIF
95 !
96  init_fluxpr=.false.
97 !
98  IF(charr.AND..NOT.susp) THEN
99  WRITE(nseo,*) ' INTEGRATED BEDLOAD DISCHARGES '
100  WRITE(nseo,*) ' VARIABLES = TIME(S) QC(M3/S) FOR',
101  & (' '//trim(chain(isec)%DESCR), isec=1,nsec)
102  ENDIF
103 !
104  IF(susp.AND..NOT.charr) THEN
105  WRITE(nseo,*) ' INTEGRATED SUSPENDED LOAD DISCHARGES '
106  WRITE(nseo,*) ' VARIABLES = TIME QS (M3/S) FOR SECTIONS '
107  & ,(ii,ii=1,nsec)
108  ENDIF
109 !
110  IF(charr.AND.susp) THEN
111  WRITE(nseo,*) ' INTEGRATED BEDLOAD AND SUSPENDED LOAD '
112  WRITE(nseo,*) 'VARIABLES = TIME , QC FOR ',
113  & (' '//trim(chain(isec)%DESCR), isec=1,nsec), ' QS FOR',
114  & (' '//trim(chain(isec)%DESCR), isec=1,nsec)
115  ENDIF
116 !
117  WRITE(nseo,100)(ii , ii= 1 ,nsec)
118 100 FORMAT(' TIME',' SECTION:',i2, 'SECTION: ',i2)
119 !
120  ENDIF
121 !
122  IF(info) THEN
123 !
124  IF(old_method) THEN
125 !
126  IF(ncsize.LE.1) THEN
127 !
128 ! SCALAR MODE
129 !
130  DO isec = 1,nsec
131 !
132  WRITE(lu,131) isec,ctrlsc(1+2*(isec-1)),
133  & ctrlsc(2+2*(isec-1)),
134  & flx(isec),volneg(isec),
135  & volpos(isec)
136 !
137 131 FORMAT(1x,/,1x,'CONTROL SECTION NUMBER ',1i2,
138  & ' (BETWEEN POINTS ',1i5,' AND ',1i5,')',//,5x,
139  & 'DISCHARGE: ',g16.7,/,5x,
140  & 'CUMULATED NEGATIVE VOLUME: ',g16.7,/,5x,
141  & 'CUMULATED POSITIVE VOLUME: ',g16.7)
142  IF(susp) THEN
143  WRITE(lu,1302) flxs(isec),
144  & volnegs(isec),
145  & volposs(isec)
146  ENDIF
147 !
148 1302 FORMAT(5x,'DISCHARGE IN SUSPENSION: ',g16.7,/,5x,
149  & 'CUMULATED NEGATIVE VOLUME: ',g16.7,/,5x,
150  & 'CUMULATED POSITIVE VOLUME: ',g16.7)
151  IF(charr) THEN
152  WRITE(lu,1304) flxc(isec),
153  & volnegc(isec),
154  & volposc(isec)
155 1304 FORMAT(5x,'BEDLOAD DISCHARGE: ',g16.7,/,5x,
156  & 'CUMULATED NEGATIVE VOLUME: ',g16.7,/,5x,
157  & 'CUMULATED POSITIVE VOLUME: ',g16.7)
158  ENDIF
159 !
160  ENDDO
161 !
162  ELSE
163 !
164 ! PARALLEL MODE
165 !
166  DO isec = 1,nsec
167 !
168 ! SECTIONS ACROSS 2 SUB-DOMAINS WILL HAVE NSEG=0 OR -1
169 ! AND -1 WANTED HERE FOR RELEVANT MESSAGE
170 !
171 !##>JR @ ADJOINTWARE: ALGORITHMIC DIFFERENTIATION
172  dtmp1 = p_min(flx(isec))
173  dtmp2 = p_max(flx(isec))
174  dtmp3 = p_min(volneg(isec))
175  dtmp4 = p_max(volpos(isec))
176 !##<JR @ ADJOINTWARE
177  ii=p_min(nseg(isec))
178  IF(ii.GE.0) THEN
179 !
180  WRITE(lu,131) isec,ctrlsc(1+2*(isec-1)),
181  & ctrlsc(2+2*(isec-1)),
182  & dtmp1+dtmp2,dtmp3,dtmp4
183 !
184  IF(susp) THEN
185 !##>JR @ ADJOINTWARE: ALGORITHMIC DIFFERENTIATION
186  dtmp1 = p_min(flxs(isec))
187  dtmp2 = p_max(flxs(isec))
188  dtmp3 = p_min(volnegs(isec))
189  dtmp4 = p_max(volposs(isec))
190 !##<JR @ ADJOINTWARE
191  WRITE(lu,1302) dtmp1+dtmp2,dtmp3,dtmp4
192  ENDIF
193  IF(charr) THEN
194 !##>JR @ ADJOINTWARE: ALGORITHMIC DIFFERENTIATION
195  dtmp1 = p_min(flxc(isec))
196  dtmp2 = p_max(flxc(isec))
197  dtmp3 = p_min(volnegc(isec))
198  dtmp4 = p_max(volposc(isec))
199 !##<JR @ ADJOINTWARE
200  WRITE(lu,1304) dtmp1+dtmp2,dtmp3,dtmp4
201  ENDIF
202 !
203 ! OLD METHOD AND SECTION ON SEVERAL SUB-DOMAIN
204 ! IN THIS CASE NOTHING IS COMPUTED
205 !
206  ELSE
207 !
208  WRITE(lu,135) isec,ctrlsc(1+2*(isec-1)),
209  & ctrlsc(2+2*(isec-1))
210 135 FORMAT(1x,/,1x,'CONTROL SECTION NUMBER ',1i2,
211  & ' (BETWEEN POINTS ',1i5,' AND ',1i5,')',//,5x,
212  & 'ACROSS TWO SUB-DOMAINS, NO COMPUTATION')
213 !
214  ENDIF
215 !
216  ENDDO
217 !
218  ENDIF
219 !
220 !-----------------------------------------------------------------------
221 !
222  ELSE
223 !
224 ! NEW METHOD
225 ! CHAIN ALLOCATED, I.E. SERIAL OR PARALLEL CASE FROM SECTIONS INPUT FILE
226 ! WE CAN APPLY CO-ORDINATES INSTEAD AND/OR NAMES OF SECTIONS
227 !
228  DO isec = 1,nsec
229 !
230  IF(ncsize.GT.1) THEN
231 !##>JR @ ADJOINTWARE: ALGORITHMIC DIFFERENTIATION
232  dtmp1 = p_sum(flx(isec))
233  dtmp2 = p_sum(volneg(isec))
234  dtmp3 = p_sum(volpos(isec))
235 !##<JR @ ADJOINTWARE
236  WRITE(lu,231) isec,trim(chain(isec)%DESCR),
237  & dtmp1,dtmp2,dtmp3
238  ELSE
239  WRITE(lu,231) isec,trim(chain(isec)%DESCR),
240  & flx(isec),volneg(isec),volpos(isec)
241  ENDIF
242 231 FORMAT(1x,/,1x,'CONTROL SECTION NUMBER ',1i2,
243  & ' (NAME ',a,')',//,5x,
244  & 'DISCHARGE: ',g16.7,/,5x,
245  & 'CUMULATED NEGATIVE VOLUME: ',g16.7,/,5x,
246  & 'CUMULATED POSITIVE VOLUME: ',g16.7)
247  IF(susp) THEN
248  IF(ncsize.GT.1) THEN
249 !##>JR @ ADJOINTWARE: ALGORITHMIC DIFFERENTIATION
250  dtmp1 = p_sum(flxs(isec))
251  dtmp2 = p_sum(volnegs(isec))
252  dtmp3 = p_sum(volposs(isec))
253 !##<JR @ ADJOINTWARE
254  WRITE(lu,2302) dtmp1,dtmp2,dtmp3
255  ELSE
256  WRITE(lu,2302)
257  & flxs(isec),volnegs(isec),volposs(isec)
258  ENDIF
259 2302 FORMAT(5x,'DISCHARGE IN SUSPENSION: ',g16.7,/,5x,
260  & 'CUMULATED NEGATIVE VOLUME: ',g16.7,/,5x,
261 
262  & 'CUMULATED POSITIVE VOLUME: ',g16.7)
263  ENDIF
264 !
265  IF(charr) THEN
266  IF(ncsize.GT.1) THEN
267 !##>JR @ ADJOINTWARE: ALGORITHMIC DIFFERENTIATION
268  dtmp1 = p_sum(flxc(isec))
269  dtmp2 = p_sum(volnegc(isec))
270  dtmp3 = p_sum(volposc(isec))
271 !##<JR @ ADJOINTWARE
272  WRITE(lu,2304) dtmp1,dtmp2,dtmp3
273  ELSE
274  WRITE(lu,2304)
275  & flxc(isec),volnegc(isec),volposc(isec)
276  ENDIF
277 2304 FORMAT(5x,'BEDLOAD DISCHARGE: ',g16.7,/,5x,
278  & 'CUMULATED NEGATIVE VOLUME: ',g16.7,/,5x,
279  & 'CUMULATED POSITIVE VOLUME: ',g16.7)
280  ENDIF
281 !
282  ENDDO
283 !
284 !
285  ENDIF ! IF OLD_METHOD
286 !
287 ! A SECTIONS OUTPUT FILE HAS BEEN GIVEN, IT IS FILLED
288 !
289  IF(trim(gai_files(gaiseo)%NAME).NE.'') THEN
290 !
291 ! ONLY BEDLOAD
292 !
293  IF(charr.AND..NOT.susp) THEN
294  IF(ncsize.GT.1) THEN
295  DO isec=1,nsec
296 !##>JR @ ADJOINTWARE: ALGORITHMIC DIFFERENTIATION
297  dtmp1 = p_sum(flxc(isec))
298  work(isec) = dtmp1
299 !##<JR @ ADJOINTWARE
300  ENDDO
301 ! IN // ONLY PROCESSOR 0 WRITES THE FILE
302  IF(ipid.EQ.0) THEN
303  WRITE(nseo,fmt=fmtzon) tps,(work(isec),isec=1,nsec)
304  ENDIF
305  ELSE
306  WRITE(nseo,fmt=fmtzon) tps,(flxc(isec),isec=1,nsec)
307  ENDIF
308  ENDIF
309 !
310 ! ONLY SUSPENSION
311 !
312  IF(susp.AND..NOT.charr) THEN
313  IF(ncsize.GT.1) THEN
314  DO isec=1,nsec
315 !##>JR @ ADJOINTWARE: ALGORITHMIC DIFFERENTIATION
316  dtmp1 = p_sum(flxs(isec))
317  work(isec) = dtmp1
318 !##<JR @ ADJOINTWARE
319  ENDDO
320 ! IN // ONLY PROCESSOR 0 WRITES THE FILE
321  IF(ipid.EQ.0) THEN
322  WRITE (nseo,fmt=fmtzon) tps,(work(isec),isec=1,nsec)
323  ENDIF
324  ELSE
325  WRITE(nseo,fmt=fmtzon) tps,(flxs(isec),isec=1,nsec)
326  ENDIF
327  ENDIF
328 !
329 ! BOTH BEDLOAD AND SUSPENSION
330 !
331  IF(susp.AND.charr) THEN
332  IF(ncsize.GT.1) THEN
333  DO isec=1,nsec
334 !##>JR @ ADJOINTWARE: ALGORITHMIC DIFFERENTIATION
335  dtmp1 = p_sum(flxc(isec))
336  work(isec) = dtmp1
337  dtmp2 = p_sum(flxs(isec))
338  workb(isec)= dtmp2
339 !##<JR @ ADJOINTWARE
340  ENDDO
341  IF(ipid.EQ.0) THEN
342  WRITE (nseo,fmt=fmtzon) tps,(work(isec),isec=1,nsec),
343  & (workb(isec), isec=1,nsec)
344  ENDIF
345  ELSE
346  WRITE (nseo,fmt=fmtzon) tps,(flxc(isec),isec=1,nsec),
347  & (flxs(isec),isec=1,nsec)
348  ENDIF
349  ENDIF
350 !
351  ENDIF
352 !
353 ! IF(INFO)...
354  ENDIF
355 !
356 !-----------------------------------------------------------------------
357 !
358  RETURN
359  END SUBROUTINE fluxpr_gaia
type(bief_file), dimension(maxlu_gai), target gai_files
For storing information on files.
subroutine fluxpr_gaia(NSEC, CTRLSC, FLX, VOLNEG, VOLPOS, INFO, TPS, NSEG, NCSIZE, FLXS, VOLNEGS, VOLPOSS, SUSP, FLXC, VOLNEGC, VOLPOSC, CHARR)
Definition: fluxpr_gaia.f:8
integer ipid
Definition: bief_def.f:49
type(chain_type), dimension(:), allocatable chain