bord.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\bord.f
00002 !
00096                      SUBROUTINE BORD
00097 !                    ***************
00098 !
00099      &(HBOR,UBOR,VBOR,TBOR,U,V,H,
00100      & ZF,NBOR,TRA05,TRA06,LIHBOR,LIUBOR,LITBOR,
00101      & XNEBOR,YNEBOR,NPOIN,NPTFR,NPTFR2,TEMPS,NDEBIT,NCOTE,NVITES,
00102      & NTRAC,NTRACE,NFRLIQ,NUMLIQ,KENT,KENTU,PROVEL,MASK,MESH,EQUA,
00103      & NOMIMP)
00104 !
00105 !***********************************************************************
00106 ! TELEMAC2D   V7P0                                   21/08/2010
00107 !***********************************************************************
00108 !
00109 !
00110 !
00111 !
00112 !
00113 !
00114 !
00115 !
00116 !
00117 !
00118 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00119 !| EQUA           |-->| STRING DESCRIBING THE EQUATIONS SOLVED
00120 !| H              |-->| DEPTH AT TIME N
00121 !| HBOR           |<->| PRESCRIBED DEPTH
00122 !| LIHBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON DEPTH
00123 !| LITBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON TRACERS
00124 !| LIUBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON VELOCITY
00125 !| MASK           |-->| BLOCK OF MASKS FOR DIFFERENT BOUNDARY CONDITIONS
00126 !| MESH           |-->| MESH STRUCTURE
00127 !| NBOR           |-->| GLOBAL NUMBER OF BOUNDARY POINTS
00128 !| NCOTE          |-->| NUMBER OF BOUNDARIES WITH PRESCRIBED ELEVATION
00129 !|                |   | AS GIVEN IN THE PARAMETER FILE
00130 !| NDEBIT         |-->| NUMBER OF BOUNDARIES WITH PRESCRIBED DISCHARGE
00131 !|                |   | AS GIVEN IN THE PARAMETER FILE
00132 !| NFRLIQ         |-->| NUMBER OF LIQUID BOUNDARIES
00133 !| NOMIMP         |-->| NAME OF LIQUID BOUNDARIES FILE
00134 !| NPOIN          |-->| NUMBER OF POINTS
00135 !| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
00136 !| NPTFR2         |-->| NUMBER OF QUADRATIC BOUNDARY POINTS
00137 !| NTRAC          |-->| NUMBER OF TRACERS
00138 !| NTRACE         |-->| NUMBER OF BOUNDARIES WITH TRACER PRESCRIBED
00139 !|                |   | AS GIVEN IN THE PARAMETER FILE
00140 !| NUMLIQ         |-->| LIQUID BOUNDARY NUMBER OF BOUNDARY POINTS
00141 !| NVITES         |-->| NUMBER OF BOUNDARIES WITH VELOCITY PRESCRIBED
00142 !|                |   | AS GIVEN IN THE PARAMETER FILE
00143 !| PROVEL         |-->| OPTION FOR VELOCITY PROFILES
00144 !| TBOR           |<--| BLOCK WITH PRESCRIBED VALUES OF TRACERS
00145 !| TEMPS          |-->| TIME IN SECONDS
00146 !| TRA05          |-->| WORK ARRAY IN A BIEF_OBJ STRUCTURE
00147 !| TRA06          |-->| WORK ARRAY IN A BIEF_OBJ STRUCTURE
00148 !| U              |-->| X-COMPONENT OF VELOCITY AT TIME N
00149 !| V              |-->| Y-COMPONENT OF VELOCITY AT TIME N
00150 !| UBOR           |<->| X-COMPONENT OF PRESCRIBED VELOCITY
00151 !| VBOR           |<->| Y-COMPONENT OF PRESCRIBED VELOCITY
00152 !| XNEBOR         |-->| X-COMPONENT OF NORMAL VECTOR AT BOUNDARY NODES
00153 !| YNEBOR         |-->| Y-COMPONENT OF NORMAL VECTOR AT BOUNDARY NODES
00154 !| ZF             |-->| BOTTOM TOPOGRAPHY
00155 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00156 !
00157       USE BIEF
00158       USE INTERFACE_TELEMAC2D, EX_BORD => BORD
00159       USE DECLARATIONS_TELEMAC2D, ONLY: STA_DIS_CURVES,PTS_CURVES,QZ,
00160      &                                  FLUX_BOUNDARIES,MAXFRO,FRTYPE,
00161      &                                  TIDALTYPE,BOUNDARY_COLOUR
00162 !
00163       IMPLICIT NONE
00164       INTEGER LNG,LU
00165       COMMON/INFO/LNG,LU
00166 !
00167 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00168 !
00169       INTEGER, INTENT(IN) :: NPOIN,NPTFR,NDEBIT,NCOTE,NVITES,NTRACE
00170       INTEGER, INTENT(IN) :: KENT,KENTU,NFRLIQ,NTRAC,NPTFR2
00171       INTEGER, INTENT(IN) :: PROVEL(*),LIHBOR(NPTFR),LIUBOR(NPTFR2)
00172       INTEGER, INTENT(IN) :: NUMLIQ(NPTFR),NBOR(NPTFR2)
00173       DOUBLE PRECISION, INTENT(IN) :: TEMPS
00174       DOUBLE PRECISION, INTENT(IN) :: ZF(NPOIN)
00175       DOUBLE PRECISION, INTENT(IN) :: XNEBOR(NPTFR),YNEBOR(NPTFR)
00176       CHARACTER(LEN=20), INTENT(IN)   :: EQUA
00177       CHARACTER(LEN=144), INTENT(IN)  :: NOMIMP
00178       DOUBLE PRECISION, INTENT(INOUT) :: UBOR(NPTFR2,2),VBOR(NPTFR2,2)
00179       DOUBLE PRECISION, INTENT(INOUT) :: HBOR(NPTFR)
00180       TYPE(BIEF_MESH), INTENT(INOUT)  :: MESH
00181       TYPE(BIEF_OBJ), INTENT(INOUT)   :: H,U,V,TRA05,TRA06,TBOR
00182       TYPE(BIEF_OBJ), INTENT(IN)      :: MASK,LITBOR
00183 !
00184 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00185 !
00186       INTEGER K,MSK8,IFRLIQ,YADEB(MAXFRO),IERR,ITRAC,IFR,N,IELEB,KP1
00187 !
00188       DOUBLE PRECISION Z,QIMP,ZMIN(MAXFRO)
00189 !
00190       LOGICAL YAZMIN
00191 !
00192       DOUBLE PRECISION P_DMIN
00193       INTEGER  P_IMAX
00194       EXTERNAL P_IMAX,P_DMIN
00195 !
00196       INTRINSIC MAX
00197 !
00198 !     PROVISOIRE
00199 !
00200       DOUBLE PRECISION DIS_STA_CUR
00201       EXTERNAL         DIS_STA_CUR
00202 !
00203 !-----------------------------------------------------------------------
00204 !
00205 !     IF VELOCITY PROFILE OPTION 5 OR STAGE-DISCHARGE CURVE Q(Z):
00206 !     THE MINIMUM ELEVATION OF EVERY BOUNDARY IS NEEDED
00207 !
00208       YAZMIN=.FALSE.
00209       DO IFR=1,NFRLIQ
00210         ZMIN(IFR)=1.D99
00211         IF(PROVEL(IFR).EQ.5.OR.STA_DIS_CURVES(IFR).EQ.2) YAZMIN=.TRUE.
00212       ENDDO
00213       IF(YAZMIN) THEN
00214         DO K=1,NPTFR
00215           IFR=NUMLIQ(K)
00216           IF(IFR.GT.0) ZMIN(IFR)=MIN(ZMIN(IFR),ZF(NBOR(K))+H%R(NBOR(K)))
00217         ENDDO
00218         IF(NCSIZE.GT.1) THEN
00219           DO IFR=1,NFRLIQ
00220             ZMIN(IFR)=P_DMIN(ZMIN(IFR))
00221           ENDDO
00222         ENDIF
00223       ENDIF
00224 !
00225 !-----------------------------------------------------------------------
00226 !
00227       MSK8 = 8
00228 !
00229 !  INITIALISATION OF YADEB
00230 !
00231       IF(NFRLIQ.GE.1) THEN
00232         DO K=1,NFRLIQ
00233           YADEB(K)=0
00234         ENDDO
00235       ENDIF
00236 !
00237 !-----------------------------------------------------------------------
00238 !
00239 !  LOOP ON ALL BOUNDARY POINTS
00240 !
00241       DO K=1,NPTFR
00242 !
00243 !  LEVEL IMPOSED WITH VALUE GIVEN IN THE CAS FILE (NCOTE0)
00244 !
00245       IF(LIHBOR(K).EQ.KENT) THEN
00246 !
00247         IFRLIQ=NUMLIQ(K)
00248 !
00249 !          IFRLIQ.EQ.0 MAY HAPPEN WITH WEIRS
00250         IF(IFRLIQ.GT.0) THEN
00251           IF(STA_DIS_CURVES(IFRLIQ).EQ.1) THEN
00252             Z = STA_DIS_CUR(IFRLIQ,FLUX_BOUNDARIES(IFRLIQ),
00253      &                      PTS_CURVES(IFRLIQ),QZ,NFRLIQ,
00254      &                      ZF(NBOR(K))+H%R(NBOR(K)))
00255             HBOR(K) = MAX( 0.D0 , Z-ZF(NBOR(K)) )
00256             H%R(NBOR(K))=HBOR(K)
00257           ELSEIF(NCOTE.GT.0.OR.NOMIMP(1:1).NE.' ') THEN
00258             N=NBOR(K)
00259             IF(NCSIZE.GT.1) N=MESH%KNOLG%I(N)
00260             Z = SL(IFRLIQ,N)
00261             HBOR(K) = MAX( 0.D0 , Z-ZF(NBOR(K)) )
00262             H%R(NBOR(K))=HBOR(K)
00263 !         ELSE HBOR TAKEN IN BOUNDARY CONDITIONS FILE
00264           ENDIF
00265         ENDIF
00266 !
00267       ENDIF
00268 !
00269 !  DISCHARGE IMPOSED: VARIOUS OPTIONS ACCORDING TO PROVEL
00270 !                 ONE USES THE VALUES PROVIDED BY THE USER
00271 !                 AS VELOCITY PROFILE.
00272 !                 UBOR(K,2) AND VBOR(K,2) ARE THE VALUES OF
00273 !                 THE CONLIM FILE, AND ARE CONSERVED.
00274 !
00275       IF(LIUBOR(K).EQ.KENT.AND.
00276      &  (NDEBIT.GT.0.OR.NOMIMP(1:1).NE.' ')) THEN
00277         IFR=NUMLIQ(K)
00278         IF(PROVEL(IFR).EQ.1) THEN
00279 !         CONSTANT NORMAL PROFILE
00280           UBOR(K,1) = -XNEBOR(K)
00281           VBOR(K,1) = -YNEBOR(K)
00282         ELSEIF(PROVEL(IFR).EQ.2) THEN
00283 !         PROFILE PROVIDED BY THE USER
00284           UBOR(K,1) = UBOR(K,2)
00285           VBOR(K,1) = VBOR(K,2)
00286         ELSEIF(PROVEL(IFR).EQ.3) THEN
00287 !         NORMAL VELOCITY PROVIDED IN UBOR
00288           UBOR(K,1) = -XNEBOR(K)*UBOR(K,2)
00289           VBOR(K,1) = -YNEBOR(K)*UBOR(K,2)
00290         ELSEIF(PROVEL(IFR).EQ.4) THEN
00291 !         NORMAL PROFILE IN SQUARE ROOT OF H
00292           UBOR(K,1) = -XNEBOR(K) * SQRT(MAX(H%R(NBOR(K)),0.D0))
00293           VBOR(K,1) = -YNEBOR(K) * SQRT(MAX(H%R(NBOR(K)),0.D0))
00294         ELSEIF(PROVEL(IFR).EQ.5) THEN
00295 !         NORMAL PROFILE IN SQUARE ROOT OF H, BUT VIRTUAL H
00296 !         DEDUCED FROM LOWEST FREE SURFACE OF THE BOUNDARY
00297           UBOR(K,1)=-XNEBOR(K)*SQRT(MAX(ZMIN(IFR)-ZF(NBOR(K)),0.D0))
00298           VBOR(K,1)=-YNEBOR(K)*SQRT(MAX(ZMIN(IFR)-ZF(NBOR(K)),0.D0))
00299         ENDIF
00300 !       ONE DOES NOT SET VELOCITY IF THERE IS NO WATER.
00301         IF(H%R(NBOR(K)).LT.1.D-3) THEN
00302           UBOR(K,1) = 0.D0
00303           VBOR(K,1) = 0.D0
00304         ENDIF
00305 !       U AND V INITIALISED WITH THE IMPOSED VALUES
00306         U%R(NBOR(K)) = UBOR(K,1)
00307         V%R(NBOR(K)) = VBOR(K,1)
00308         YADEB(NUMLIQ(K))=1
00309       ENDIF
00310 !
00311 !  VELOCITY IMPOSED: ONE USES THE OUTGOING DIRECTION
00312 !                    PROVIDED BY THE USER.
00313 !
00314       IF(LIUBOR(K).EQ.KENTU.AND.
00315      &  (NVITES.NE.0.OR.NOMIMP(1:1).NE.' ')) THEN
00316 !       POINTS ON WEIRS HAVE NUMLIQ(K)=0
00317         IF(NUMLIQ(K).GT.0) THEN
00318           IFR=NUMLIQ(K)
00319           IF(PROVEL(IFR).EQ.1) THEN
00320             N=NBOR(K)
00321             IF(NCSIZE.GT.1) N=MESH%KNOLG%I(N)
00322             UBOR(K,1) = - XNEBOR(K) * VIT(NUMLIQ(K),N)
00323             VBOR(K,1) = - YNEBOR(K) * VIT(NUMLIQ(K),N)
00324           ELSEIF(PROVEL(IFR).EQ.2) THEN
00325             UBOR(K,1) = UBOR(K,2)
00326             VBOR(K,1) = VBOR(K,2)
00327           ELSEIF(PROVEL(IFR).EQ.3) THEN
00328             UBOR(K,1) = - XNEBOR(K) * UBOR(K,2)
00329             VBOR(K,1) = - YNEBOR(K) * UBOR(K,2)
00330           ELSE
00331             IF(LNG.EQ.1) THEN
00332               WRITE(LU,*) 'FRONTIERE ',IFR
00333               WRITE(LU,*) 'PROFIL ',PROVEL(IFR),
00334      &                    ' DEMANDE AVEC VITESSES IMPOSEES'
00335               WRITE(LU,*) 'COMBINAISON ILLOGIQUE'
00336             ENDIF
00337             IF(LNG.EQ.2) THEN
00338               WRITE(LU,*) 'BOUNDARY ',IFR
00339               WRITE(LU,*) 'PROFILE ',PROVEL(IFR),
00340      &                    ' ASKED'
00341               WRITE(LU,*) 'IMPOSSIBLE COMBINATION'
00342             ENDIF
00343             CALL PLANTE(1)
00344             STOP
00345           ENDIF
00346 !         U AND V INITIALISED WITH THE IMPOSED VALUES
00347 !         IF NOT IN THOMPSON MODE
00348           IF(FRTYPE(IFR).NE.2) THEN
00349             U%R(NBOR(K)) = UBOR(K,1)
00350             V%R(NBOR(K)) = VBOR(K,1)
00351           ENDIF
00352         ENDIF
00353       ENDIF
00354 !
00355 !  IMPOSED TRACER
00356 !
00357       IF(NTRAC.GT.0) THEN
00358         DO ITRAC=1,NTRAC
00359         IF(LITBOR%ADR(ITRAC)%P%I(K).EQ.KENT.AND.
00360      &    (NTRACE.GT.0.OR.NOMIMP(1:1).NE.' ')) THEN
00361 !         THE CASE NUMLIQ(K)=0 CORRESPONDS TO A SINGULARITY INITIALLY
00362 !         DECLARED AS A SOLID BOUNDARY AND FOR WHICH
00363 !         TBOR IS FILLED IN CLHUVT
00364           IF(NUMLIQ(K).GT.0) THEN
00365             N=NBOR(K)
00366             IF(NCSIZE.GT.1) N=MESH%KNOLG%I(N)
00367             Z = TR(NUMLIQ(K),ITRAC,N,IERR)
00368             IF(IERR.EQ.0) TBOR%ADR(ITRAC)%P%R(K) = Z
00369           ENDIF
00370         ENDIF
00371         ENDDO
00372       ENDIF
00373 !
00374       ENDDO ! K
00375 !
00376 !-----------------------------------------------------------------------
00377 !
00378 !     AUTOMATIC TIDAL BOUNDARY CONDITIONS
00379 !
00380       IF(TIDALTYPE.GE.1) CALL TIDAL_MODEL_T2D()
00381 !
00382 !-----------------------------------------------------------------------
00383 !
00384 !  QUADRATIC VELOCITIES
00385 !
00386       IF(U%ELM .EQ.13)THEN
00387         DO IELEB=1,MESH%NELEB
00388           K  =MESH%IKLBOR%I(IELEB)
00389           KP1=MESH%IKLBOR%I(IELEB+MESH%NELEBX)
00390           IF(LIUBOR(K+NPTFR).EQ.KENT.AND.
00391      &      (NDEBIT.GT.0.OR.NOMIMP(1:1).NE.' ')) THEN
00392             U%R(NBOR(K+NPTFR)) = (UBOR(K,1)+UBOR(KP1,1))*0.5D0
00393             V%R(NBOR(K+NPTFR)) = (VBOR(K,1)+VBOR(KP1,1))*0.5D0
00394           ENDIF
00395         ENDDO
00396       ENDIF
00397 !
00398 !-----------------------------------------------------------------------
00399 !
00400 !  CASE OF DISCHARGE IMPOSED:
00401 !
00402 !  LOOP ON LIQUID BOUNDARIES
00403 !
00404       IF(NFRLIQ.NE.0) THEN
00405 !
00406         DO IFRLIQ = 1 , NFRLIQ
00407 !
00408           IF(NDEBIT.GT.0.OR.NOMIMP(1:1).NE.' ') THEN
00409 !
00410 !           ONE TAKES THE MASK OF LIQUID BOUNDARIES MSK8, WHICH IS
00411 !           EQUAL TO THE MASK OF THE DISCHARGE IMPOSED ON A DISCHARGE
00412 !           IMPOSED BOUNDARY. THIS MAKES IT POSSIBLE TO CHANGE A FREE
00413 !           VELOCITY BOUNDARY TO A DISCHARGE IMPOSED TO A LEVEL IMPOSED
00414 !           BOUNDARY, IN SPITE OF THE FACT THAT THE MASKS ARE MADE IN
00415 !           PROPIN BEFORE THE CALL TO BORD
00416 !
00417             IF(NCSIZE.GT.1) YADEB(IFRLIQ)=P_IMAX(YADEB(IFRLIQ))
00418             IF(YADEB(IFRLIQ).EQ.1) THEN
00419               IF(STA_DIS_CURVES(IFRLIQ).EQ.2) THEN
00420                 QIMP=DIS_STA_CUR(IFRLIQ,PTS_CURVES(IFRLIQ),QZ,NFRLIQ,
00421      &                           ZMIN(IFRLIQ))
00422               ELSE
00423                 QIMP=Q(IFRLIQ)
00424               ENDIF
00425               CALL DEBIMP(QIMP,UBOR,VBOR,U,V,H,NUMLIQ,
00426      &                    IFRLIQ,TRA05,TRA06,
00427      &                    NPTFR,MASK%ADR(MSK8)%P%R,MESH,MESH%KP1BOR%I,
00428      &                    EQUA)
00429             ENDIF
00430 !
00431           ENDIF
00432 !
00433         ENDDO
00434 !
00435       ENDIF
00436 !
00437 !-----------------------------------------------------------------------
00438 !
00439 !  QUADRATIC VELOCITIES
00440 !
00441       IF(U%ELM.EQ.13) THEN
00442         DO IELEB=1,MESH%NELEB
00443           K  =MESH%IKLBOR%I(IELEB)
00444           KP1=MESH%IKLBOR%I(IELEB+MESH%NELEBX)
00445           UBOR(K+NPTFR,1) =(UBOR(K,1)+UBOR(KP1,1))*0.5D0
00446           VBOR(K+NPTFR,1) =(VBOR(K,1)+VBOR(KP1,1))*0.5D0
00447         ENDDO
00448       ENDIF
00449 !
00450 !-----------------------------------------------------------------------
00451 !
00452       RETURN
00453       END

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