debimp.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\debimp.f
00002 !
00078                      SUBROUTINE DEBIMP
00079 !                    *****************
00080 !
00081      &(Q,UBOR,VBOR,U,V,H,NUMLIQ,IFRLIQ,WORK1,WORK2,NPTFR,MASK,MESH,
00082      & KP1BOR)
00083 !
00084 !***********************************************************************
00085 ! TELEMAC2D   V7P0                                   19/03/2014
00086 !***********************************************************************
00087 !
00088 !
00089 !
00090 !
00091 !
00092 !
00093 !
00094 !
00095 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00096 !| IFRLIQ         |-->| RANK OF LIQUID BOUNDARY
00097 !| KP1BOR         |-->| GIVES THE NEXT BOUNDARY POINT IN A CONTOUR
00098 !| MASK           |-->| BLOCK OF MASKS FOR BOUNDARY CONDITIONS
00099 !| MESH           |-->| MESH STRUCTURE
00100 !| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
00101 !| NUMLIQ         |-->| LIQUID BOUNDARY NUMBER OF BOUNDARY POINTS
00102 !| Q              |-->| PRESCRIBED VALUE OF DISCHARGE
00103 !| UBOR           |<--| PRESCRIBED BOUNDARY CONDITION ON VELOCITY U
00104 !| VBOR           |<--| PRESCRIBED BOUNDARY CONDITION ON VELOCITY V
00105 !| U              |-->| X-COMPONENT OF VELOCITY
00106 !| V              |-->| Y-COMPONENT OF VELOCITY
00107 !| H              |-->| WATER DEPTH
00108 !| WORK1          |<->| WORK BIEF_OBJ STRUCTURE
00109 !| WORK2          |<->| WORK BIEF_OBJ STRUCTURE
00110 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00111 !
00112       USE BIEF
00113 !
00114       IMPLICIT NONE
00115       INTEGER LNG,LU
00116       COMMON/INFO/LNG,LU
00117 !
00118 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00119 !
00120       INTEGER, INTENT(IN)             :: NPTFR,IFRLIQ
00121       INTEGER, INTENT(IN)             :: NUMLIQ(NPTFR),KP1BOR(NPTFR,2)
00122       DOUBLE PRECISION, INTENT(INOUT) :: UBOR(NPTFR),VBOR(NPTFR)
00123       DOUBLE PRECISION, INTENT(IN)    :: MASK(*),Q
00124       TYPE(BIEF_MESH), INTENT(INOUT)  :: MESH
00125       TYPE(BIEF_OBJ), INTENT(IN)      :: H
00126       TYPE(BIEF_OBJ), INTENT(INOUT)   :: WORK1,WORK2,U,V
00127 !
00128 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00129 !
00130       INTEGER K,IELM,N,IELEB
00131 !
00132       DOUBLE PRECISION Q1
00133 !
00134       INTRINSIC ABS
00135 !
00136       DOUBLE PRECISION P_DSUM
00137       EXTERNAL         P_DSUM
00138 !
00139 !=======================================================================
00140 !     COMPUTES FLUX
00141 !=======================================================================
00142 !
00143 !  IN THE FOLLOWING LOOP ONE RESTRICTS THE MASK OF DIRICHLETS SEGMENTS
00144 !  TO THOSE OF THE LIQUID BOUNDARY NUMBER IFRLIQ. AS NUMLIQ IS
00145 !  DEFINED AT NODES, ONE RISKS AN ERROR FOR THE SEGMENT FOLLOWING
00146 !  THE LAST NODE ON THE BOUNDARY. IN FACT THIS SEGMENT WILL BE SOLID
00147 !  AND WILL HAVE A MASK ALREADY SET TO ZERO.
00148 !
00149       CALL OS( 'X=0     ' , X=WORK1 )
00150 !
00151       DO IELEB=1,MESH%NELEB
00152         K=MESH%IKLBOR%I(IELEB)
00153         IF(NUMLIQ(K).EQ.IFRLIQ) WORK1%R(IELEB)=MASK(IELEB)
00154       ENDDO
00155 !
00156       IELM=11
00157       CALL VECTOR(WORK2,'=','FLUBDF          ',IELBOR(IELM,1),
00158      &            1.D0,H,H,H,U,V,V,MESH,.TRUE.,WORK1)
00159 !     SIGN CONVENTION REVERSED BETWEEN USER AND CODE
00160 !     FOR THE USER: POSITIVE DISCHARGE = ENTERING
00161 !     FOR THE CODE: U.N < 0 = ENTERING
00162       Q1 = - BIEF_SUM(WORK2)
00163       IF(NCSIZE.GT.1) Q1 = P_DSUM(Q1)
00164 !
00165       IF(ABS(Q1).LT.1.D-10) THEN
00166 !
00167 !       ZERO FLUX: WARNING MESSAGE
00168 !
00169         IF(ABS(Q).GT.1.D-10) THEN
00170           IF(LNG.EQ.1) WRITE(LU,30) IFRLIQ
00171           IF(LNG.EQ.2) WRITE(LU,31) IFRLIQ
00172 30        FORMAT(1X,'DEBIMP : PROBLEME SUR LA FRONTIERE ',1I6     ,/,1X,
00173      &              '         DONNER UN PROFIL DE VITESSES       ',/,1X,
00174      &              '         DANS LE :                          ',/,1X,
00175      &              '         FICHIER DES CONDITIONS AUX LIMITES ',/,1X,
00176      &              '         OU VERIFIER LES HAUTEURS D''EAU.   ',/,1X,
00177      &              '         AUTRE CAUSE POSSIBLE :             ',/,1X,
00178      &              '         ENTREE TORRENTIELLE A HAUTEUR LIBRE',/,1X,
00179      &              '         METTRE UNE HAUTEUR NON NULLE       ',/,1X,
00180      &              '         DANS LES CONDITIONS INITIALES      ',/,1X,
00181      &              '         OU IMPOSER LA HAUTEUR D''EAU EN ENTREE.')
00182 31        FORMAT(1X,'DEBIMP: PROBLEM ON BOUNDARY NUMBER ',1I6     ,/,1X,
00183      &              '        GIVE A VELOCITY PROFILE             ',/,1X,
00184      &              '        IN THE BOUNDARY CONDITIONS FILE     ',/,1X,
00185      &              '        OR CHECK THE WATER DEPTHS.          ',/,1X,
00186      &              '        OTHER POSSIBLE CAUSE:               ',/,1X,
00187      &              '        SUPERCRITICAL ENTRY WITH FREE DEPTH ',/,1X,
00188      &              '        IN THIS CASE GIVE A POSITIVE DEPTH  ',/,1X,
00189      &              '        IN THE INITIAL CONDITIONS           ',/,1X,
00190      &              '        OR PRESCRIBE THE DEPTH AT THE ENTRANCE.')
00191           CALL PLANTE(1)
00192           STOP
00193         ELSE
00194           Q1 = 1.D0
00195         ENDIF
00196 !
00197       ENDIF
00198 !
00199 !=======================================================================
00200 !   COMPUTES UBOR AND VBOR
00201 !=======================================================================
00202 !
00203       DO K=1,NPTFR
00204 !
00205         IF(NUMLIQ(K).EQ.IFRLIQ) THEN
00206           N=MESH%NBOR%I(K)
00207           UBOR(K) = UBOR(K) * Q / Q1
00208           VBOR(K) = VBOR(K) * Q / Q1
00209 !         WE DO NOT LET THE PREVIOUS UBOR WHICH IS ONLY A PROFILE
00210 !         THIS HAS AN EFFECT AT LEAST IN PROPIN_TELEMAC2D
00211 !         WHICH IS CALLED BEFORE THE TREATMENT OF DIRICHLET CONDITIONS
00212           U%R(N) = UBOR(K)
00213           V%R(N) = VBOR(K)
00214         ENDIF
00215 !
00216       ENDDO
00217 !
00218 !-----------------------------------------------------------------------
00219 !
00220       RETURN
00221       END

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