debimp3d.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac3d\debimp3d.f
00002 !
00086                      SUBROUTINE DEBIMP3D
00087 !                    *******************
00088 !
00089      &(Q,UBOR,VBOR,WBOR,U,V,H,NUMLIQ,IFRLIQ,
00090      & T3_01,T3_02,T3_03,
00091      & NPTFR,NETAGE,MASK,MESH,FORMUL,NPOIN2,
00092      & IELM2V,SIGMAG,SVIDE,MASKBR,ZPROP)
00093 !
00094 !***********************************************************************
00095 ! TELEMAC3D   V6P1                                   21/08/2010
00096 !***********************************************************************
00097 !
00098 !
00099 !
00100 !
00101 !
00102 !
00103 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00104 !| FORMUL         |---| 'FLUBOR          ' ONLY IN PRACTICE
00105 !| IELM2V         |-->| DISCRETISATION TYPE FOR 2D VERTICAL MESH
00106 !| IFRLIQ         |-->| NUMBER OF LIQUID BOUNDARY
00107 !| MASK           |-->| MASK
00108 !| MASKBR         |<->| MASK OF DIRICHLETS SEGMENTS RESTRICTED
00109 !|                |<->| TO A FEW LIQUID BOUNDARIES
00110 !| MESH           |---| MESH
00111 !| NETAGE         |-->| NUMBER OF PLANES - 1
00112 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D
00113 !| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
00114 !| NUMLIQ         |-->| LIQUID BOUNDARY NUMBER OF BOUNDARY POINTS
00115 !| Q              |-->| VALUE OF PRESCRIBED FLOWRATE DU DEBIT IMPOSE
00116 !| SIGMAG         |-->| LOGICAL FOR GENERALISED SIGMA TRANSFORMATION
00117 !|                |   | NOT USED
00118 !| SVIDE          |<->| DUMMY
00119 !| T3_01          |<->| WORK ARRAY: NOT USED
00120 !| T3_02          |<->| WORK ARRAY
00121 !| T3_03          |<->| WORK ARRAY: NOT USED
00122 !| UBOR           |<->| INLET PRESCRIBED BOUNDARY CONDITION ON VELOCITY U
00123 !| VBOR           |<->| INLET PRESCRIBED BOUNDARY CONDITION ON VELOCITY V
00124 !| WBOR           |<->| INLET PRESCRIBED BOUNDARY CONDITION ON VELOCITY W
00125 !| ZPROP          |<->| VERTICAL COORDINATES FOR PROPAGATION STEP: NOT USED
00126 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00127 !
00128       USE BIEF
00129 !
00130       IMPLICIT NONE
00131       INTEGER LNG,LU
00132       COMMON/INFO/LNG,LU
00133 !
00134 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00135 !
00136       INTEGER, INTENT(IN) :: NPTFR,NETAGE,NPOIN2,IFRLIQ
00137       INTEGER, INTENT(IN) :: NUMLIQ(NPTFR)
00138 !
00139       DOUBLE PRECISION, INTENT(INOUT) :: UBOR(*),VBOR(*),WBOR(*)
00140       DOUBLE PRECISION, INTENT(IN) :: MASK(*)
00141       DOUBLE PRECISION, INTENT(IN) :: Q
00142 !
00143       CHARACTER(LEN=16) FORMUL
00144 !
00145       INTEGER, INTENT(IN) :: IELM2V
00146       LOGICAL, INTENT(IN) :: SIGMAG
00147       TYPE(BIEF_MESH) :: MESH
00148       TYPE(BIEF_OBJ), INTENT(INOUT) :: MASKBR
00149       TYPE(BIEF_OBJ) , INTENT(INOUT):: H,U,V
00150       TYPE(BIEF_OBJ) , INTENT(INOUT):: T3_01,T3_02,T3_03
00151       TYPE(BIEF_OBJ) , INTENT(INOUT) :: ZPROP
00152       TYPE(BIEF_OBJ) , INTENT(INOUT) :: SVIDE
00153 !
00154 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00155 !
00156       INTEGER K,IETAGE,IPTFR,I3D
00157       DOUBLE PRECISION Q1
00158 !
00159       INTRINSIC ABS
00160       DOUBLE PRECISION P_DSUM
00161       EXTERNAL         P_DSUM
00162 !
00163 !=======================================================================
00164 !     COMPUTES THE FLUX
00165 !=======================================================================
00166 !
00167 !  IN THE FOLLOWING LOOP RESTRICTS THE MASK OF DIRICHLETS SEGMENTS
00168 !  TO THOSE OF THE LIQUID BOUNDARY NUMBER IFRLIQ. AS NUMLIQ IS
00169 !  DEFINED AT NODES, POSSIBLY INTRODUCES AN ERROR FOR THE SEGMENT
00170 !  FOLLOWING THE LAST BOUNDARY NODE. IN FACT THIS SEGMENT WILL BE
00171 !  SOLID AND WILL ALREADY HAVE A MASK AT 0.
00172 !
00173       CALL OS('X=0     ',X=MASKBR)
00174 !
00175 !  CHECKS IF THERE'S A DIRICHLET ON EITHER U OR V
00176 !
00177       IF(MASKBR%ELM.EQ.70) THEN
00178 !
00179 !         QUADRILATERAL ON THE LATERAL BOUNDARIES
00180 !
00181           DO K = 1,NPTFR
00182             IF(NUMLIQ(K).EQ.IFRLIQ) THEN
00183               DO IETAGE = 1,NETAGE
00184                 MASKBR%R((IETAGE-1)*NPTFR+K)=MASK(K)
00185               ENDDO
00186             ENDIF
00187           ENDDO
00188 !
00189       ELSEIF(MASKBR%ELM.EQ.60) THEN
00190 !
00191 !         TRIANGLES ON THE LATERAL BOUNDARIES
00192 !
00193           DO K = 1,NPTFR
00194             IF(NUMLIQ(K).EQ.IFRLIQ) THEN
00195               DO IETAGE = 1,NETAGE
00196                 MASKBR%R((IETAGE-1)*2*NPTFR+K      )=MASK(K)
00197                 MASKBR%R((IETAGE-1)*2*NPTFR+K+NPTFR)=MASK(K)
00198               ENDDO
00199             ENDIF
00200           ENDDO
00201 !
00202       ELSE
00203         WRITE(LU,*) 'UNKNOWN ELEMENT FOR MASKBR IN DEBIMP3D'
00204         CALL PLANTE(1)
00205         STOP
00206       ENDIF
00207 !
00208       FORMUL = 'FLUBOR          '
00209 !     IF (SIGMAG) FORMUL(7:7) = '2'
00210       CALL VECTOR(T3_02,'=',FORMUL,IELM2V,1.D0,SVIDE,SVIDE,SVIDE,
00211      &            U,V,SVIDE,MESH,.TRUE.,MASKBR)
00212 !
00213       Q1 = - BIEF_SUM(T3_02)
00214 !
00215       IF(NCSIZE.GT.1) Q1=P_DSUM(Q1)
00216 !
00217 !  ZERO FLOW: WARNING MESSAGE
00218 !
00219       IF(ABS(Q1).LT.1.D-10) THEN
00220         IF(ABS(Q).GT.1.D-10) THEN
00221           IF(LNG.EQ.1) WRITE(LU,30) IFRLIQ
00222           IF(LNG.EQ.2) WRITE(LU,31) IFRLIQ
00223 30        FORMAT(1X,'DEBIMP3D : PROBLEME SUR LA FRONTIERE ',1I6,/,1X,
00224      &     '         DONNER UN PROFIL DE VITESSES        ',/,1X,
00225      &     '         DANS LE FICHIER DES CONDITIONS AUX LIMITES',/,1X,
00226      &     '         OU VERIFIER LES HAUTEURS D''EAU')
00227 31        FORMAT(1X,'DEBIMP3D : PROBLEM ON BOUNDARY NUMBER ',1I6,/,1X,
00228      &     '         GIVE A VELOCITY PROFILE  ',/,1X,
00229      &     '         IN THE BOUNDARY CONDITIONS FILE',/,1X,
00230      &     '         OR CHECK THE WATER DEPTHS')
00231           CALL PLANTE(1)
00232           STOP
00233         ELSE
00234           Q1 = 1.D0
00235         ENDIF
00236       ENDIF
00237 !
00238 !=======================================================================
00239 !   NORMALISES UBOR VBOR WBOR
00240 !=======================================================================
00241 !
00242       DO IPTFR=1,NPTFR
00243         IF(NUMLIQ(IPTFR).EQ.IFRLIQ) THEN
00244           DO IETAGE =1, NETAGE+1
00245             I3D=(IETAGE-1)*NPTFR+IPTFR
00246             UBOR(I3D) = UBOR(I3D) * Q / Q1
00247             VBOR(I3D) = VBOR(I3D) * Q / Q1
00248 !           SEE BORD3D
00249 !           WBOR(I3D) = 0.D0
00250           ENDDO
00251         ENDIF
00252       ENDDO
00253 !
00254 !-----------------------------------------------------------------------
00255 !
00256       RETURN
00257       END

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