breach.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\breach.f
00002 !
00051                         SUBROUTINE BREACH
00052 !                       ******************
00053 !
00054 !
00055 !***********************************************************************
00056 ! TELEMAC2D   V6P2                                   03/08/2012
00057 !***********************************************************************
00058 !
00059 !BRIEF    MODIFICATION OF THE BOTTOM TOPOGRAPHY FOR BREACHES
00060 !
00061 !
00062 !HISTORY  P. CHASSE (CETMEF) / C. COULET (ARTELIA)
00063 !+        03/08/2012
00064 !+        V6P2
00065 !+        CREATION
00066 !
00067 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00068 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00069 !
00070       USE BIEF
00071       USE DECLARATIONS_TELEMAC2D
00072 !
00073       IMPLICIT NONE
00074       INTEGER LNG,LU
00075       COMMON/INFO/LNG,LU
00076 !
00077 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00078 !
00079       LOGICAL, SAVE :: DEJALU=.FALSE.
00080 !
00081       INTEGER I, J, K, N
00082       DOUBLE PRECISION ZC, ZW, ZB
00083       DOUBLE PRECISION AT1, AT2
00084 !
00085       INTEGER          P_ISUM
00086       DOUBLE PRECISION P_DMAX,P_DMIN,P_DSUM
00087       EXTERNAL         P_ISUM,P_DMAX,P_DMIN,P_DSUM
00088 !
00089 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00090 !
00091       IF (.NOT.DEJALU) THEN
00092         IF(DEBUG.GT.0) WRITE(LU,*) 'CALLING LECBREACH'
00093         CALL LECBREACH(T2D_FILES(T2DBRC)%LU)
00094         IF(DEBUG.GT.0) WRITE(LU,*) 'BACK FROM LECBREACH'
00095         DEJALU=.TRUE.
00096         IF(LNG.EQ.1) WRITE (LU,*) 'LECTURE DONNEES BRECHE = OK'
00097         IF(LNG.EQ.2) WRITE (LU,*) 'READING BREACH DATA = OK'
00098 !
00099         DO I = 1, NBRECH
00100            ZCRBR%R(I) = -HUGE(100.D0)
00101            DO J = 1, NBNDBR%I(I)
00102               K = INDBR%ADR(I)%P%I(J)
00103               IF(ZF%R(K).GT.ZCRBR%R(I)) THEN
00104                 ZCRBR%R(I) = ZF%R(K)
00105               ENDIF
00106            ENDDO
00107            IF(NCSIZE.GT.1) THEN
00108              ZCRBR%R(I) = P_DMAX(ZCRBR%R(I))
00109            ENDIF
00110         ENDDO
00111       ENDIF
00112 !
00113       DO I = 1, NBRECH
00114         IF((OPTNBR%I(I).EQ.2).AND.(TDECBR%R(I).LT.0.D0)) THEN
00115           ZC = 0.D0
00116           N = 0
00117           DO J = 1, NBNDBR%I(I)
00118             K = INDBR%ADR(I)%P%I(J)
00119             IF(H%R(K).GT.0.D0) THEN
00120               ZW = ZF%R(K)+H%R(K)
00121               ZC = ZC + ZW
00122               N = N + 1
00123             ENDIF
00124           ENDDO
00125           IF(NCSIZE.GT.1) THEN
00126             N = P_ISUM(N)
00127             ZC = P_DSUM(ZC)
00128           ENDIF
00129           IF(N.GT.1) ZC = ZC/N
00130           IF(ZC.GT.ZDECBR%R(I)) THEN
00131             IF(LNG.EQ.1) WRITE(LU,10) I, AT
00132             IF(LNG.EQ.2) WRITE(LU,20) I, AT
00133             TDECBR%R(I) = AT
00134           ENDIF
00135         ENDIF
00136         IF((OPTNBR%I(I).EQ.3).AND.(TDECBR%R(I).LT.0.D0)) THEN
00137           IF(NUMPSD%I(I).GT.0) THEN
00138             ZW = ZF%R(NUMPSD%I(I)) + H%R(NUMPSD%I(I))
00139           ELSE
00140             ZW = 0.D0
00141           ENDIF
00142 !         CASE WHERE ONE OF THE ENDS IS NOT IN THE SUB-DOMAIN
00143           IF(NCSIZE.GT.1) THEN
00144             ZW = P_DMAX(ZW)+P_DMIN(ZW)
00145           ENDIF
00146           IF(ZW.GT.ZDECBR%R(I)) THEN
00147             IF(LNG.EQ.1) WRITE(LU,10) I, AT
00148             IF(LNG.EQ.2) WRITE(LU,20) I, AT
00149             TDECBR%R(I) = AT
00150           ENDIF
00151         ENDIF
00152 !
00153         AT1 = TDECBR%R(I)
00154         AT2 = AT1 + DURBR%R(I)
00155         IF(AT1.GT.0.D0) THEN
00156           IF(AT.GT.AT1) THEN
00157             IF(AT.GT.AT2) THEN
00158               ZB = ZFINBR%R(I)
00159             ELSE
00160               ZB = ZCRBR%R(I)+(ZFINBR%R(I)-ZCRBR%R(I))/(AT2-AT1)
00161      &             *(AT-AT1)
00162             ENDIF
00163             DO J = 1, NBNDBR%I(I)
00164               K = INDBR%ADR(I)%P%I(J)
00165               ZF%R(K)=MIN(ZF%R(K), ZB)
00166             ENDDO
00167           ENDIF
00168         ENDIF
00169       ENDDO
00170 !
00171 !-----------------------------------------------------------------------
00172 !     MESSAGES
00173 10    FORMAT(1X,'CREATION DE LA BRECHE : ',I4,/,1X,
00174      &          'AU TEMPS : ',G16.7)
00175 20    FORMAT(1X,'CREATION OF BREACH : ',I4,/,1X,
00176      &          'AT TIME : ',G16.7)
00177 !-----------------------------------------------------------------------
00178 !
00179       RETURN
00180       END

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