loi_w_inc.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\loi_w_inc.f
00002 !
00023                      SUBROUTINE LOI_W_INC
00024 !                    ********************
00025 !
00026      &(YAM,YAV,YS1,YS2,WIDTH,PHI,DEB,G)
00027 !
00028 !***********************************************************************
00029 ! TELEMAC2D   V6P3                                   13/06/2013
00030 !***********************************************************************
00031 !
00032 !BRIEF    DISCHARGE LAW FOR AN INCLINATED WEIR.
00033 !
00034 !HISTORY  C. COULET (ARTELIA)
00035 !+        13/06/2013
00036 !+ INSPIRED FROM CARIMA PROGRAM
00037 !+
00038 !
00039 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00040 !| DEB            |<--| DISCHARGE OF WEIR
00041 !| G              |-->| GRAVITY.
00042 !| PHI            |-->| DISCHARGE COEFFICIENT OF WEIR.
00043 !| WIDTH          |-->| WIDTH OF WEIR
00044 !| YAM            |-->| UPSTREAM ELEVATION
00045 !| YAV            |-->| DOWNSTREAM ELEVATION
00046 !| YS1            |-->| ELEVATION OF WEIR (SIDE1)
00047 !| YS2            |-->| ELEVATION OF WEIR (SIDE2)
00048 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00049 !
00050       IMPLICIT NONE
00051       INTEGER LNG,LU
00052       COMMON/INFO/LNG,LU
00053 !
00054 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00055 !
00056       DOUBLE PRECISION, INTENT(INOUT) :: DEB
00057       DOUBLE PRECISION, INTENT(IN)    :: G,YAM,YAV,PHI,YS1,YS2,WIDTH
00058 !
00059       DOUBLE PRECISION :: SLOPE,XPD,XD,XPN,XN,QD,QN
00060       DOUBLE PRECISION :: AUX0,AUX1,AUX2,AUX3,AUX4
00061       DOUBLE PRECISION :: YSMIN
00062 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00063 !
00064       SLOPE = DABS(YS1-YS2)/WIDTH
00065 !
00066       IF (SLOPE.GT.1.D-4) THEN
00067         YSMIN = DMIN1(YS1,YS2)
00068         XPD = (YAM-YSMIN)/SLOPE
00069       ELSE
00070         YSMIN = YS1
00071         XPD = WIDTH
00072       ENDIF
00073       IF (XPD.GE.WIDTH) THEN
00074         XD = WIDTH
00075       ELSE
00076         XD = XPD
00077       ENDIF
00078 !
00079       XPN = 3.D0*YAV - 2.D0*YAM - YSMIN
00080       IF (XPN.LE.0.D0) THEN
00081         XN = 0.D0
00082       ELSEIF (XPN.LE.WIDTH*SLOPE) THEN
00083         XN = XPN / SLOPE
00084       ELSE
00085         XN = WIDTH
00086       ENDIF
00087 !
00088       IF(YAM.LT.YSMIN.AND.YAV.LT.YSMIN) THEN
00089         DEB=0.D0
00090       ELSE
00091         QN = ((YAV-YSMIN)*XN - 0.5D0*SLOPE*XN**2)*SQRT(YAM-YAV)
00092         IF (SLOPE.GT.1.D-4) THEN
00093           AUX0 = YAM-YSMIN
00094           AUX1 = MAX(YAM-YSMIN-XD*SLOPE, 0.D0)
00095           AUX2 = MAX(YAM-YSMIN-XN*SLOPE, 0.D0)
00096           AUX3 = AUX1**1.5D0 - AUX2**1.5D0
00097           AUX4 = XD*AUX1**1.5D0 + 2.D0/(5.D0*SLOPE)*AUX1**2.5D0 -
00098      &           XN*AUX2**1.5D0 - 2.D0/(5.D0*SLOPE)*AUX2**2.5D0
00099           QD = PHI * 2.D0/(3.D0*SLOPE) * (SLOPE*AUX4-AUX0*AUX3)
00100         ELSE
00101           QD = PHI * (YAM-YSMIN) * SQRT(YAM-YSMIN) * (XD-XN)
00102         ENDIF
00103 !
00104         DEB=SQRT(2.D0*G)*(QN+QD)
00105 !
00106       ENDIF
00107 !
00108 !-----------------------------------------------------------------------
00109 !
00110       RETURN
00111       END

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