clsing.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\clsing.f
00002 !
00085                      SUBROUTINE CLSING
00086 !                    *****************
00087 !
00088      &(NWEIRS,NPSING,NDGA1,NDGB1,X,Y,ZF,CHESTR,NKFROT,KARMAN,
00089      & ZDIG,PHIDIG,NBOR,H,T,NTRAC,IOPTAN,UNORM,
00090      & UBOR,VBOR,TBOR,LIHBOR,LIUBOR,LIVBOR,LITBOR,GRAV)
00091 !
00092 !***********************************************************************
00093 ! TELEMAC2D   V7P0                                   21/08/2010
00094 !***********************************************************************
00095 !
00096 !
00097 !
00098 !
00099 !
00100 !
00101 !
00102 !
00103 !
00104 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00105 !| CHESTR         |-->| FRICTION COEFFICIENT
00106 !| GRAV           |-->| GRAVITY
00107 !| H              |-->| WATER DEPTH
00108 !| IOPTAN         |-->| OPTION FOR TANGENTIAL VELOCITIES.
00109 !| KARMAN         |-->| VON KARMAN CONSTANT.
00110 !| LIHBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON DEPTH
00111 !| LIUBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON VELOCITY
00112 !| LITBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON TRACERS
00113 !| NBOR           |-->| GLOBAL NUMBER OF BOUNDARY POINTS
00114 !| NKFROT         |-->| FRICTION LAW, PER POINT
00115 !| NPSING         |-->| NUMBER OF POINTS FOR EVERY SINGULARITY.
00116 !| NTRAC          |-->| NUMBER OF TRACERS
00117 !| NDGA1          |-->| NDGA1%ADR(I)%I(NP) : BOUNDARY NUMBER OF POINT NP
00118 !|                |   | OF WEIR I (side1)
00119 !| NDGB1          |-->| NDGB1%ADR(I)%I(NP) : BOUNDARY NUMBER OF POINT NP
00120 !|                |   | OF WEIR I (side2)
00121 !| NWEIRS         |-->| NUMBER OF SINGULARITIES
00122 !| PHIDIG         |-->| DISCHARGE COEFFICIENT OF THE WEIR
00123 !| T              |-->| BLOCK OF TRACERS
00124 !| UBOR           |<--| PRESCRIBED BOUNDARY CONDITION ON VELOCITY U
00125 !| VBOR           |<--| PRESCRIBED BOUNDARY CONDITION ON VELOCITY V
00126 !| TBOR           |<--| PRESCRIBED BOUNDARY CONDITION ON TRACER
00127 !| UNORM          |-->| NORM OF VELOCITY
00128 !| X              |-->| ABSCISSAE OF NODES
00129 !| Y              |-->| ORDINATES OF NODES
00130 !| ZDIG           |-->| ELEVATIONS OF POINTS OF WEIRS
00131 !| ZF             |-->| BOTTOM TOPOGRAPHY
00132 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00133 !
00134       USE BIEF
00135       USE INTERFACE_TELEMAC2D, EX_CLSING => CLSING
00136 !
00137       IMPLICIT NONE
00138       INTEGER LNG,LU
00139       COMMON/INFO/LNG,LU
00140 !
00141 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00142 !
00143       INTEGER, INTENT(IN)             :: NWEIRS,IOPTAN
00144       INTEGER, INTENT(IN)             :: NKFROT(*),NBOR(*)
00145       INTEGER, INTENT(INOUT)          :: LIUBOR(*),LIVBOR(*),LIHBOR(*)
00146       INTEGER, INTENT(IN)             :: NTRAC
00147       DOUBLE PRECISION, INTENT(IN)    :: H(*)
00148       DOUBLE PRECISION, INTENT(IN)    :: X(*),Y(*),ZF(*),CHESTR(*)
00149       DOUBLE PRECISION, INTENT(IN)    :: KARMAN,GRAV
00150       DOUBLE PRECISION, INTENT(INOUT) :: UBOR(*),VBOR(*)
00151       DOUBLE PRECISION, INTENT(INOUT) :: UNORM(*)
00152       TYPE(BIEF_OBJ)  , INTENT(IN)    :: NPSING,NDGA1,NDGB1
00153       TYPE(BIEF_OBJ)  , INTENT(IN)    :: PHIDIG,ZDIG
00154       TYPE(BIEF_OBJ)  , INTENT(INOUT) :: TBOR,LITBOR
00155       TYPE(BIEF_OBJ)  , INTENT(IN)    :: T
00156 !
00157 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00158 !
00159       INTEGER I,N,IA,IB,NA,NB
00160 !
00161       DOUBLE PRECISION HMIN,PHI,QAB,YAA,YBB,YDEN,YS,HA,HB,ZFA,ZFB
00162 !
00163       DOUBLE PRECISION P_DMAX,P_DMIN
00164       EXTERNAL         P_DMAX,P_DMIN
00165 !
00166 !-----------------------------------------------------------------------
00167 !
00168       HMIN=1.D-3
00169 !
00170 !     COMPUTES UNIT DISCHARGES
00171 !
00172       DO N=1,NWEIRS
00173       DO I=1,NPSING%I(N)
00174 !
00175         IA=NDGA1%ADR(N)%P%I(I)
00176         IF(IA.GT.0) THEN
00177           NA=NBOR(IA)
00178           HA=H(NA)
00179           ZFA=ZF(NA)
00180         ELSE
00181           HA=0.D0
00182           ZFA=0.D0
00183         ENDIF
00184 !
00185         IB=NDGB1%ADR(N)%P%I(I)
00186         IF(IB.GT.0) THEN
00187           NB=NBOR(IB)
00188           HB=H(NB)
00189           ZFB=ZF(NB)
00190         ELSE
00191           HB=0.D0
00192           ZFB=0.D0
00193         ENDIF
00194 !
00195         IF(NCSIZE.GT.1) THEN
00196           HB =P_DMAX(HB)+P_DMIN(HB)
00197           HA =P_DMAX(HA)+P_DMIN(HA)
00198           ZFA=P_DMAX(ZFA)+P_DMIN(ZFA)
00199           ZFB=P_DMAX(ZFB)+P_DMIN(ZFB)
00200         ENDIF
00201 !
00202         YAA=HA+ZFA
00203         YBB=HB+ZFB
00204 !
00205         YS=ZDIG%ADR(N)%P%R(I)
00206         PHI=PHIDIG%ADR(N)%P%R(I)
00207 !
00208         IF(YAA.GT.YBB) THEN
00209 !         CASE WHERE A IS UPSTREAM
00210           YDEN=YS/3.D0+2.D0*YAA/3.D0
00211           IF(YBB.LT.YDEN) THEN
00212             CALL LOIDEN(YAA,YS,PHI,QAB,GRAV)
00213           ELSE
00214             CALL LOINOY(YAA,YBB,YS,PHI,QAB,GRAV)
00215           ENDIF
00216         ELSE
00217 !         CASE WHERE B IS UPSTREAM
00218           YDEN=YS/3.D0+2.D0*YBB/3.D0
00219           IF(YAA.LT.YDEN) THEN
00220             CALL LOIDEN(YBB,YS,PHI,QAB,GRAV)
00221           ELSE
00222             CALL LOINOY(YBB,YAA,YS,PHI,QAB,GRAV)
00223           ENDIF
00224           QAB=-QAB
00225         ENDIF
00226 !
00227 !       COMPUTES THE NORMAL DISCHARGE
00228 !       IN CLHUVT ONLY UNORM OF POINTS IN THE DOMAIN
00229 !       WILL BE USED
00230 !
00231         IF(IA.GT.0) THEN
00232           IF(HA.LE.HMIN) THEN
00233             UNORM(IA)=0.D0
00234           ELSE
00235             UNORM(IA)=-QAB/HA
00236           ENDIF
00237         ENDIF
00238 !
00239         IF(IB.GT.0) THEN
00240           IF(HB.LE.HMIN) THEN
00241             UNORM(IB)=0.D0
00242           ELSE
00243             UNORM(IB)=-QAB/HB
00244           ENDIF
00245         ENDIF
00246 !
00247       ENDDO ! I
00248       ENDDO ! N
00249 !
00250 !     DETERMINES THE NUMERICAL VALUE
00251 !     OF THE BOUNDARY CONDITIONS:
00252 !
00253       CALL CLHUVT(NWEIRS,NPSING,NDGA1,NDGB1,ZDIG,X,Y,ZF,
00254      &            IOPTAN,UNORM,CHESTR,NKFROT,KARMAN,T,NTRAC,H,
00255      &            UBOR,VBOR,TBOR,NBOR,LIHBOR,LIUBOR,LIVBOR,LITBOR)
00256 !
00257 !-----------------------------------------------------------------------
00258 !
00259       RETURN
00260       END

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