The TELEMAC-MASCARET system  trunk
q.f
Go to the documentation of this file.
1 ! ***************************
2  DOUBLE PRECISION FUNCTION q
3 ! ***************************
4 !
5  &(i)
6 !
7 !***********************************************************************
8 ! TELEMAC2D V6P2 08/11/2011
9 !***********************************************************************
10 !
11 !brief PRESCRIBES THE DISCHARGE FOR FLOW IMPOSED
12 !+ LIQUID BOUNDARIES.
13 !
14 !history J-M HERVOUET (LNHE)
15 !+ 09/01/2004
16 !+ V5P6
17 !+
18 !
19 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
20 !+ 13/07/2010
21 !+ V6P0
22 !+ Translation of French comments within the FORTRAN sources into
23 !+ English comments
24 !
25 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
26 !+ 21/08/2010
27 !+ V6P0
28 !+ Creation of DOXYGEN tags for automated documentation and
29 !+ cross-referencing of the FORTRAN sources
30 !
31 !history C. COULET (ARTELIA GROUP)
32 !+ 08/11/2011
33 !+ V6P2
34 !+ Modification of FCT size due to modification of TRACER numbering
35 !
36 !history J-M HERVOUET (LNHE)
37 !+ 21/05/2012
38 !+ V6P2
39 !+ Discharge taken at mid distance between AT-DT AND AT, except
40 !+ for finite volumes (DT unknown, and AT time of beginning of time
41 !+ step in this case)
42 !
43 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
44 !| I |-->| NUMBER OF THE LIQUID BOUNDARY.
45 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
46 !
47  USE bief
51  USE interface_telemac2d, ex_q => q
52 !
53  IMPLICIT NONE
54 !
55 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
56 !
57  INTEGER , INTENT(IN) :: I
58 !
59 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
60 !
61  CHARACTER(LEN=9) FCT
62  DOUBLE PRECISION Q1,Q2
63 !
64 !-----------------------------------------------------------------------
65 !
66 ! IF LIQUID BOUNDARY FILE EXISTS, ATTEMPTS TO FIND
67 ! THE VALUE IN IT. IF YES, OKQ REMAINS TO .TRUE. FOR NEXT CALLS
68 ! IF NO, OKQ IS SET TO .FALSE.
69 !
70  IF(okq(i).AND.t2d_files(t2dimp)%NAME(1:1).NE.' ') THEN
71 !
72 ! FCT WILL BE Q(1), Q(2), ETC, Q(99), DEPENDING ON I
73  fct='Q( '
74  IF(i.LT.10) THEN
75  WRITE(fct(3:3),fmt='(I1)') i
76  fct(4:4)=')'
77  ELSEIF(i.LT.100) THEN
78  WRITE(fct(3:4),fmt='(I2)') i
79  fct(5:5)=')'
80  ELSE
81  WRITE(lu,*) 'Q NOT PROGRAMMED FOR MORE THAN 99 BOUNDARIES'
82  CALL plante(1)
83  stop
84  ENDIF
85  IF(equa(1:15).NE.'SAINT-VENANT VF') THEN
86  CALL read_fic_frliq(q1,fct,at-dt,
87  & t2d_files(t2dimp)%LU,entet,okq(i))
88  CALL read_fic_frliq(q2,fct,at ,
89  & t2d_files(t2dimp)%LU,entet,okq(i))
90  q=(q1+q2)*0.5d0
91  ELSE
92  CALL read_fic_frliq(q,fct,at ,
93  & t2d_files(t2dimp)%LU,entet,okq(i))
94  ENDIF
95 !
96  ENDIF
97 !
98  IF(.NOT.okq(i).OR.t2d_files(t2dimp)%NAME(1:1).EQ.' ') THEN
99 !
100 ! Q IS TAKEN FROM THE STEERING FILE, BUT MAY BE CHANGED
101 !
102  IF(ndebit.GE.i) THEN
103  q = debit(i)
104 !
105  ! USER UPDATE OF VALUE
106  CALL user_q(i, q)
107  ELSE
108  WRITE(lu,401) i
109 401 FORMAT(1x,/,1x,'Q : MORE PRESCRIBED FLOWRATES',/,
110  & 1x,' ARE REQUIRED IN THE PARAMETER FILE',/,
111  & 1x,' AT LEAST ',1i6,' MUST BE GIVEN')
112  CALL plante(1)
113  stop
114  ENDIF
115 !
116  ENDIF
117 !
118 !-----------------------------------------------------------------------
119 !
120  RETURN
121  END
double precision, dimension(:), pointer x
double precision, dimension(:), allocatable, target debit
subroutine read_fic_frliq(Q, WHAT, AT, NFIC, LISTIN, FOUND)
Definition: read_fic_frliq.f:7
character(len=20), target equa
double precision function q(I)
Definition: q.f:7
subroutine user_q(I, Q)
Definition: user_q.f:7
double precision, target at
logical, dimension(:), allocatable okq
double precision, target dt
type(bief_file), dimension(maxlu_t2d), target t2d_files
Definition: bief.f:3