debimp_3d.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac3d\debimp_3d.f
00002 !
00081                      SUBROUTINE DEBIMP_3D
00082 !                    ********************
00083 !
00084      &(Q,UBOR,VBOR,WBOR,U,V,NUMLIQ,NUMLIQ_ELM,IFRLIQ,T3_02,
00085      & NPTFR,NETAGE,MASK,MESH,FORMUL,IELM2V,SVIDE,MASKBR,NELEB)
00086 !
00087 !***********************************************************************
00088 ! TELEMAC3D   V7P0                                   19/03/2014
00089 !***********************************************************************
00090 !
00091 !
00092 !
00093 !
00094 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00095 !| FORMUL         |---| 'FLUBOR          ' ONLY IN PRACTICE
00096 !| IELM2V         |-->| DISCRETISATION TYPE FOR 2D VERTICAL MESH
00097 !| IFRLIQ         |-->| NUMBER OF LIQUID BOUNDARY
00098 !| MASK           |-->| MASK
00099 !| MASKBR         |<->| MASK OF DIRICHLETS SEGMENTS RESTRICTED
00100 !|                |<->| TO A FEW LIQUID BOUNDARIES
00101 !| MESH           |---| MESH
00102 !| NETAGE         |-->| NUMBER OF PLANES - 1
00103 !| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
00104 !| NUMLIQ         |-->| LIQUID BOUNDARY NUMBER OF BOUNDARY POINTS
00105 !| NUMLIQ_ELM     |-->| LIQUID BOUNDARY NUMBER OF BOUNDARY ELEMENTS
00106 !| Q              |-->| VALUE OF PRESCRIBED FLOWRATE DU DEBIT IMPOSE
00107 !| SVIDE          |<->| DUMMY
00108 !| T3_02          |<->| WORK ARRAY
00109 !| U              |-->| X-COMPONENT OF VELOCITY
00110 !| UBOR           |<->| INLET PRESCRIBED BOUNDARY CONDITION ON VELOCITY U
00111 !| V              |-->| Y-COMPONENT OF VELOCITY
00112 !| VBOR           |<->| INLET PRESCRIBED BOUNDARY CONDITION ON VELOCITY V
00113 !| WBOR           |<->| INLET PRESCRIBED BOUNDARY CONDITION ON VELOCITY W
00114 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00115 !
00116       USE BIEF
00117 !
00118       IMPLICIT NONE
00119       INTEGER LNG,LU
00120       COMMON/INFO/LNG,LU
00121 !
00122 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00123 !
00124       INTEGER, INTENT(IN) :: NPTFR,NETAGE,IFRLIQ,NELEB
00125       INTEGER, INTENT(IN) :: NUMLIQ(NPTFR),NUMLIQ_ELM(NELEB)
00126 !
00127       DOUBLE PRECISION, INTENT(INOUT) :: UBOR(*),VBOR(*),WBOR(*)
00128       DOUBLE PRECISION, INTENT(IN) :: Q
00129 !
00130       CHARACTER(LEN=16) FORMUL
00131 !
00132       INTEGER, INTENT(IN)            :: IELM2V
00133       TYPE(BIEF_MESH)                :: MESH
00134       TYPE(BIEF_OBJ) , INTENT(IN)    :: MASK
00135       TYPE(BIEF_OBJ) , INTENT(INOUT) :: MASKBR
00136       TYPE(BIEF_OBJ) , INTENT(INOUT) :: U,V
00137       TYPE(BIEF_OBJ) , INTENT(INOUT) :: T3_02
00138       TYPE(BIEF_OBJ) , INTENT(INOUT) :: SVIDE
00139 !
00140 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00141 !
00142       INTEGER K,IETAGE,IPTFR,I3D,IELEB
00143       DOUBLE PRECISION Q1
00144 !
00145       INTRINSIC ABS
00146       DOUBLE PRECISION P_DSUM
00147       EXTERNAL         P_DSUM
00148 !
00149 !=======================================================================
00150 !     COMPUTES THE FLUX OBTAINED IF UBOR AND VBOR ARE UNCHANGED
00151 !=======================================================================
00152 !
00153 !     U AND V ARE SET HERE TO THE PRESCRIBED VALUES (THAT MAY EVOLVE IN
00154 !     TIME AND NOT BE EQUAL TO DIRICHLET VALUE OF PREVIOUS TIME STEP)
00155 !
00156       DO IPTFR=1,NPTFR
00157         IF(NUMLIQ(IPTFR).EQ.IFRLIQ) THEN
00158           DO IETAGE=1,NETAGE+1
00159             I3D=(IETAGE-1)*NPTFR+IPTFR
00160             U%R(MESH%NBOR%I(I3D))=UBOR(I3D)
00161             V%R(MESH%NBOR%I(I3D))=VBOR(I3D)
00162 !           W%R = WILL NOT CHANGE THE FLUX IF BOUNDARY VERTICAL
00163           ENDDO
00164         ENDIF
00165       ENDDO
00166 !
00167 !     IN THE FOLLOWING LOOP ONE RESTRICTS THE MASK OF DIRICHLET ELEMENTS
00168 !     TO THOSE OF THE LIQUID BOUNDARY NUMBER IFRLIQ.
00169 !
00170       CALL OS('X=0     ',X=MASKBR)
00171 !
00172 !     LOOP ON BOUNDARY ELEMENTS
00173 !
00174       DO IELEB=1,NELEB
00175         IF(NUMLIQ_ELM(IELEB).EQ.IFRLIQ) MASKBR%R(IELEB)=MASK%R(IELEB)
00176       ENDDO
00177 !
00178       FORMUL = 'FLUBOR          '
00179 !     IF (SIGMAG) FORMUL(7:7) = '2'
00180       CALL VECTOR(T3_02,'=',FORMUL,IELM2V,1.D0,SVIDE,SVIDE,SVIDE,
00181      &            U,V,SVIDE,MESH,.TRUE.,MASKBR)
00182 !
00183       Q1 = - BIEF_SUM(T3_02)
00184 !
00185       IF(NCSIZE.GT.1) Q1=P_DSUM(Q1)
00186 !
00187 !     ZERO FLOW: WARNING MESSAGE
00188 !
00189       IF(ABS(Q1).LT.1.D-10) THEN
00190         IF(ABS(Q).GT.1.D-10) THEN
00191           IF(LNG.EQ.1) WRITE(LU,30) IFRLIQ
00192           IF(LNG.EQ.2) WRITE(LU,31) IFRLIQ
00193 30        FORMAT(1X,'DEBIMP_3D : PROBLEME SUR LA FRONTIERE ',1I6,/,1X,
00194      &     '         DONNER UN PROFIL DE VITESSES        ',/,1X,
00195      &     '         DANS LE FICHIER DES CONDITIONS AUX LIMITES',/,1X,
00196      &     '         OU VERIFIER LES HAUTEURS D''EAU',/,1X,
00197      &     '         AUTRE CAUSE POSSIBLE :',/,1X,
00198      &     '         ENTREE TORRENTIELLE A HAUTEUR LIBRE')
00199 31        FORMAT(1X,'DEBIMP_3D: PROBLEM ON BOUNDARY NUMBER ',1I6,/,1X,
00200      &     '         GIVE A VELOCITY PROFILE  ',/,1X,
00201      &     '         IN THE BOUNDARY CONDITIONS FILE',/,1X,
00202      &     '         OR CHECK THE WATER DEPTHS',/,1X,
00203      &     '         OTHER POSSIBLE CAUSE:',/,1X,
00204      &     '         SUPERCRITICAL ENTRANCE WITH FREE DEPTH')
00205           CALL PLANTE(1)
00206           STOP
00207         ELSE
00208           Q1 = 1.D0
00209         ENDIF
00210       ENDIF
00211 !
00212 !=======================================================================
00213 !   NORMALISES UBOR VBOR WBOR
00214 !=======================================================================
00215 !
00216       DO IPTFR=1,NPTFR
00217         IF(NUMLIQ(IPTFR).EQ.IFRLIQ) THEN
00218           DO IETAGE=1,NETAGE+1
00219             I3D=(IETAGE-1)*NPTFR+IPTFR
00220             UBOR(I3D) = UBOR(I3D) * Q / Q1
00221             VBOR(I3D) = VBOR(I3D) * Q / Q1
00222 !           U%R(MESH%NBOR%I(I3D))=UBOR(I3D)
00223 !           V%R(MESH%NBOR%I(I3D))=VBOR(I3D)
00224 !           SEE BORD3D
00225 !           WBOR(I3D) = 0.D0
00226           ENDDO
00227         ENDIF
00228       ENDDO
00229 !
00230 !-----------------------------------------------------------------------
00231 !
00232       RETURN
00233       END

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