buse.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\buse.f
00002 !
00070                      SUBROUTINE BUSE
00071 !                    ***************
00072 !
00073      &(RELAXB,NBUSE,ENTBUS,SORBUS,GRAV,
00074      & H,ZF,DBUS,LRGBUS,HAUBUS,CLPBUS,
00075      & ALTBUS,CSBUS,CEBUS,ANGBUS,LBUS,
00076      & NTRAC,T,TBUS,UBUS,VBUS,U,V,ENTET)
00077 !
00078 !***********************************************************************
00079 ! TELEMAC2D   V6P2                                   23/05/2012
00080 !***********************************************************************
00081 !
00082 !
00083 !
00084 !
00085 !
00086 !
00087 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00088 !| ALTBUS         |-->| ELEVATIONS OF TUBES
00089 !| ANGBUS         |-->| ANGLE OF TUBES WITH AXIS OX.
00090 !| CEBUS          |-->| HEAD LOSS COEFFICIENT WHEN WORKING AS AN INFLOW
00091 !| CLPBUS         |-->| INTEGER FLAG FOR FLOW DIRECTION (VALVE)
00092 !|                |   | 0 - BOTH DIRECTIONS
00093 !|                |   | 1 - ONLY FROM ENTRY TO EXIT
00094 !|                |   | 2 - ONLY FROM EXIT TO ENTRY
00095 !|                |   | 3 - NO FLOW
00096 !| CSBUS          |-->| HEAD LOSS COEFFICIENT WHEN WORKING AS AN OUTFLOW
00097 !| DBUS           |-->| DISCHARGE OF TUBES.
00098 !| ENTET          |-->| IF YES, PRINTING INFORMATION ON LISTING
00099 !| ENTBUS         |-->| INDICES OF ENTRY OF TUBES IN GLOBAL NUMBERING
00100 !| GRAV           |-->| GRAVITY
00101 !| H              |-->| DEPTH
00102 !| LBUS           |-->| LINEAR HEAD LOSS OF TUBE
00103 !| LBUS           |-->| LINEAR HEAD LOSS OF TUBE
00104 !| NBUSE          |-->| NUMBER OF TUBES
00105 !| NTRAC          |-->| NUMBER OF TRACERS
00106 !| RELAXB         |-->| RELAXATION COEFFICIENT
00107 !| SORBUS         |-->| INDICES OF TUBES EXITS IN GLOBAL NUMBERING
00108 !| T              |-->| BLOCK OF TRACERS
00109 !| TBUS           |<->| VALUES OF TRACERS AT TUBES EXTREMITY
00110 !| U              |-->| X-COMPONENT OF VELOCITY
00111 !| UBUS           |<->| VELOCITY U AT TUBES EXTREMITY
00112 !| V              |-->| Y-COMPONENT OF VELOCITY
00113 !| VBUS           |<->| VELOCITY V AT TUBES EXTREMITY
00114 !| ZF             |-->| ELEVATION OF BOTTOM
00115 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00116 !
00117       USE BIEF
00118       USE DECLARATIONS_TELEMAC2D, ONLY : V2DPAR,DT,SECBUS
00119 !
00120       IMPLICIT NONE
00121       INTEGER LNG,LU
00122       COMMON/INFO/LNG,LU
00123 !
00124 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00125 !
00126       INTEGER          , INTENT(IN)    :: NBUSE,NTRAC
00127       INTEGER          , INTENT(IN)    :: ENTBUS(NBUSE),SORBUS(NBUSE)
00128       LOGICAL          , INTENT(IN)    :: ENTET
00129       DOUBLE PRECISION , INTENT(IN)    :: RELAXB,GRAV
00130       DOUBLE PRECISION , INTENT(INOUT) :: UBUS(NBUSE,2),VBUS(NBUSE,2)
00131       DOUBLE PRECISION , INTENT(INOUT) :: DBUS(NBUSE)
00132       TYPE(BIEF_OBJ)   , INTENT(INOUT) :: TBUS
00133       DOUBLE PRECISION , INTENT(IN)    :: ANGBUS(NBUSE,2),LBUS(NBUSE)
00134       DOUBLE PRECISION , INTENT(IN)    :: CEBUS(NBUSE,2),CSBUS(NBUSE,2)
00135       DOUBLE PRECISION , INTENT(IN)    :: ALTBUS(NBUSE,2)
00136       DOUBLE PRECISION , INTENT(IN)    :: LRGBUS(NBUSE),HAUBUS(NBUSE)
00137       INTEGER          , INTENT(IN)    :: CLPBUS(NBUSE)
00138       DOUBLE PRECISION , INTENT(IN)    :: H(*),ZF(*),U(*),V(*)
00139       TYPE(BIEF_OBJ)   , INTENT(IN)    :: T
00140 !
00141 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00142 !
00143       INTEGER N,I1,I2,ITRAC
00144 !
00145       DOUBLE PRECISION L,LARG,HAUT
00146       DOUBLE PRECISION S1,S2,CE1,CE2,CS1,CS2,Q,QMAX1,QMAX2
00147       DOUBLE PRECISION RD1,RD2
00148 !
00149       INTRINSIC SQRT,COS,SIN
00150 !
00151       DOUBLE PRECISION P_DMAX,P_DMIN
00152       EXTERNAL         P_DMAX,P_DMIN
00153 !
00154 !-----------------------------------------------------------------------
00155 !
00156 ! LOOP OVER THE TUBES
00157 !
00158       DO N=1,NBUSE
00159 !
00160 !     IDENTIFIES ENTRY / EXIT NODES
00161 !
00162 !     NUMBER OF THE POINTS
00163       I1=ENTBUS(N)
00164       I2=SORBUS(N)
00165 !
00166 !     LOADS, TAKEN AS FREE SURFACE ELEVATION
00167 !
00168       IF(I1.GT.0) THEN
00169         S1=H(I1)+ZF(I1)
00170         QMAX1=0.9D0*H(I1)*V2DPAR%R(I1)/DT
00171       ELSE
00172         S1=0.D0
00173         QMAX1=0.D0
00174       ENDIF
00175       IF(I2.GT.0) THEN
00176         S2=H(I2)+ZF(I2)
00177         QMAX2=0.9D0*H(I2)*V2DPAR%R(I2)/DT
00178       ELSE
00179         S2=0.D0
00180         QMAX2=0.D0
00181       ENDIF
00182 !     CASE WHERE ONE OF THE ENDS IS NOT IN THE SUB-DOMAIN
00183       IF(NCSIZE.GT.1) THEN
00184         S1=P_DMAX(S1)+P_DMIN(S1)
00185         S2=P_DMAX(S2)+P_DMIN(S2)
00186         QMAX1=P_DMAX(QMAX1)+P_DMIN(QMAX1)
00187         QMAX2=P_DMAX(QMAX2)+P_DMIN(QMAX2)
00188       ENDIF
00189 !
00190 !     COEFFICIENTS FOR COMPUTATION OF PRESSURE LOSS
00191 !
00192       CE1=CEBUS(N,1)
00193       CE2=CEBUS(N,2)
00194       CS1=CSBUS(N,1)
00195       CS2=CSBUS(N,2)
00196       L  =LBUS(N)
00197       RD1 =ALTBUS(N,1)
00198       RD2 =ALTBUS(N,2)
00199       LARG=LRGBUS(N)
00200       HAUT=HAUBUS(N)
00201 !
00202 !     COMPUTES THE FLOW ACCORDING TO DELTAH
00203 !     IF THE LINEAR PRESSURE LOSS IS NEGLIGIBLE, COULD HAVE DIFFERENT
00204 !     ENTRY / EXIT SECTIONS
00205 !
00206       IF(S1.GE.S2) THEN
00207 !
00208         IF(S1.GT.RD1.AND.S1.GT.RD2) THEN
00209 !
00210           IF(S1.LT.(RD1+HAUT).AND.S1.LT.(RD2+HAUT)) THEN
00211 !           FREE SURFACE FLOW WHICH FOLLOW A WEIR LAW
00212             IF(S2.GT.(0.666666667D0*(S1-RD2)+RD2)) THEN
00213               Q = LARG * SQRT( 2.D0*GRAV*(S1-S2)/(CE1+L+CS2) )*(S2-RD2)
00214               SECBUS%R(N) = (S2-RD2) * LARG
00215             ELSE
00216               Q = LARG * SQRT(2.D0*GRAV) * (S1-RD1)**1.5D0 * 0.385D0
00217               SECBUS%R(N) = (S1-RD1) * LARG
00218             ENDIF
00219           ELSE
00220 !           PRESSURE FLOW --> ORIFICE LAW
00221             SECBUS%R(N) = LARG * HAUT
00222             IF(S1.GE.(RD1+HAUT)) THEN
00223               Q = SECBUS%R(N) * SQRT( 2.D0*GRAV*(S1-S2)/(CE1+L) )
00224             ELSE
00225               Q = SECBUS%R(N) * SQRT( 2.D0*GRAV*(S1-S2)/(L+CS2+CE1) )
00226             ENDIF
00227           ENDIF
00228         ELSE
00229           Q=0.D0
00230         ENDIF
00231 !
00232       ELSE
00233 !
00234         IF(S2.GT.RD1.AND.S2.GT.RD2) THEN
00235 !
00236           IF(S2.LT.(RD1+HAUT).AND.S2.LT.(RD2+HAUT)) THEN
00237 !           FREE SURFACE FLOW WHICH FOLLOW A WEIR LAW
00238             IF(S1.GT.(0.6667*(S2-RD1)+RD1)) THEN
00239               Q=-LARG*SQRT(2.D0*GRAV*(S2-S1)/(CE2+L+CS1))*(S1-RD1)
00240               SECBUS%R(N) = (S1-RD1) * LARG
00241             ELSE
00242               Q = - LARG * SQRT( 2.D0*GRAV ) * SQRT((S2-RD2)**3) * 0.385
00243               SECBUS%R(N) = (S2-RD2) * LARG
00244             ENDIF
00245           ELSE
00246 !           PRESSURE FLOW --> ORIFICE LAW
00247             SECBUS%R(N) = LARG * HAUT
00248             IF(S2.GE.(RD2+HAUT)) THEN
00249               Q = - SECBUS%R(N) * SQRT( 2.D0*GRAV*(S2-S1)/(CE2+L) )
00250             ELSE
00251               Q = - SECBUS%R(N) * SQRT( 2.D0*GRAV*(S2-S1)/(L+CS1+CE2) )
00252             ENDIF
00253           ENDIF
00254         ELSE
00255           Q=0.D0
00256         ENDIF
00257       ENDIF
00258 !
00259 !     NOTHING HAPPENS IF THE LOADS AT THE 2 ENDS ARE LOWER THAN
00260 !     THE ELEVATION OF THE NOZZLES
00261 !
00262       IF(S1.LT.RD1.AND.S2.LT.RD2) Q=0.D0
00263 !
00264 !     SLUICE VALVE TREATMENT
00265 !
00266       IF ((CLPBUS(N).EQ.1.AND.S2.GT.S1).OR.
00267      &    (CLPBUS(N).EQ.2.AND.S1.GT.S2).OR.
00268      &    (CLPBUS(N).EQ.3))
00269      &    Q = 0.D0
00270 !
00271 !     FILLS OUT DBUS(N) USING RELAXATION
00272 !
00273       DBUS(N)= RELAXB * Q + (1.D0-RELAXB) * DBUS(N)
00274 !
00275 !     LIMITATION WITH AVAILABLE WATER
00276 !
00277       IF(DBUS(N).GT.0.D0) THEN
00278         DBUS(N)=MIN(QMAX1,DBUS(N))
00279       ELSE
00280         DBUS(N)=MAX(-QMAX2,DBUS(N))
00281       ENDIF
00282 !
00283       IF(ENTET.AND.ABS(DBUS(N)).GT.1.D-4) THEN
00284         WRITE(LU,*) ' '
00285         IF(LNG.EQ.1) THEN
00286           WRITE(LU,*) 'BUSE ',N,' DEBIT DE ',DBUS(N),' M3/S'
00287         ENDIF
00288         IF(LNG.EQ.2) THEN
00289           WRITE(LU,*) 'TUBE ',N,' DISCHARGE OF ',DBUS(N),' M3/S'
00290         ENDIF
00291         WRITE(LU,*) ' '
00292       ENDIF
00293 !
00294 !  TREATS THE VELOCITIES AT THE SOURCES
00295 !  SAME APPROACH FOR VELOCITY AND TRACER
00296 !
00297       IF(DBUS(N).GT.0.D0) THEN
00298         UBUS(N,2) = ( DBUS(N)/SECBUS%R(N) ) * COS(ANGBUS(N,2))
00299         VBUS(N,2) = ( DBUS(N)/SECBUS%R(N) ) * SIN(ANGBUS(N,2))
00300         IF(I1.GT.0) THEN
00301           UBUS(N,1) = U(I1)
00302           VBUS(N,1) = V(I1)
00303         ELSE
00304           UBUS(N,1) = 0.D0
00305           VBUS(N,1) = 0.D0
00306         ENDIF
00307         IF(NCSIZE.GT.1) THEN
00308           UBUS(N,1)=P_DMAX(UBUS(N,1))+P_DMIN(UBUS(N,1))
00309           VBUS(N,1)=P_DMAX(VBUS(N,1))+P_DMIN(VBUS(N,1))
00310         ENDIF
00311       ELSE
00312         UBUS(N,1) = ( DBUS(N)/SECBUS%R(N) ) * COS(ANGBUS(N,1))
00313         VBUS(N,1) = ( DBUS(N)/SECBUS%R(N) ) * SIN(ANGBUS(N,1))
00314         IF(I2.GT.0) THEN
00315           UBUS(N,2) = U(I2)
00316           VBUS(N,2) = V(I2)
00317         ELSE
00318           UBUS(N,2) = 0.D0
00319           VBUS(N,2) = 0.D0
00320         ENDIF
00321         IF(NCSIZE.GT.1) THEN
00322           UBUS(N,2)=P_DMAX(UBUS(N,2))+P_DMIN(UBUS(N,2))
00323           VBUS(N,2)=P_DMAX(VBUS(N,2))+P_DMIN(VBUS(N,2))
00324         ENDIF
00325       ENDIF
00326 !
00327 !     TREATS THE TRACER :
00328 !     NOTA : NBUSE + N <==> N,2
00329 !                    N <==> N,1
00330 !
00331       IF(NTRAC.GT.0) THEN
00332         DO ITRAC=1,NTRAC
00333           IF(DBUS(N).GE.0.D0) THEN ! I1 --> I2
00334 !           CASE DBUS(N)=0.D0 NOT CLEAR, BUT A VALUE HAS TO BE
00335 !           GIVEN HERE, LEST IT IS USED AFTER
00336             IF(I1.GT.0) THEN
00337               TBUS%ADR(ITRAC)%P%R(NBUSE+N)=T%ADR(ITRAC)%P%R(I1)
00338               TBUS%ADR(ITRAC)%P%R(N)      =T%ADR(ITRAC)%P%R(I1)
00339             ELSE
00340               TBUS%ADR(ITRAC)%P%R(NBUSE+N)=0.D0
00341               TBUS%ADR(ITRAC)%P%R(N)      =0.D0
00342             ENDIF
00343           ELSE ! I2 --> I1
00344             IF(I2.GT.0) THEN
00345               TBUS%ADR(ITRAC)%P%R(N)      =T%ADR(ITRAC)%P%R(I2)
00346               TBUS%ADR(ITRAC)%P%R(NBUSE+N)=T%ADR(ITRAC)%P%R(I2)
00347             ELSE
00348               TBUS%ADR(ITRAC)%P%R(N)      =0.D0
00349               TBUS%ADR(ITRAC)%P%R(NBUSE+N)=0.D0
00350             ENDIF
00351           ENDIF
00352           IF(NCSIZE.GT.1) THEN
00353             TBUS%ADR(ITRAC)%P%R(NBUSE+N)=
00354      &        P_DMAX(TBUS%ADR(ITRAC)%P%R(NBUSE+N))
00355      &       +P_DMIN(TBUS%ADR(ITRAC)%P%R(NBUSE+N))
00356             TBUS%ADR(ITRAC)%P%R(N)      =
00357      &        P_DMAX(TBUS%ADR(ITRAC)%P%R(N))
00358      &       +P_DMIN(TBUS%ADR(ITRAC)%P%R(N))
00359           ENDIF
00360         ENDDO
00361       ENDIF
00362 !
00363 !  END OF THE LOOP OVER THE TUBES
00364 !
00365       ENDDO ! N
00366 !
00367 !-----------------------------------------------------------------------
00368 !
00369       RETURN
00370       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0