maskbd.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\maskbd.f
00002 !
00066                      SUBROUTINE MASKBD
00067 !                    *****************
00068 !
00069      &(MASKEL,ZFE,ZF,HN,HMIN,IKLE,IFABOR,ITRA01,NELEM,NPOIN)
00070 !
00071 !***********************************************************************
00072 ! BIEF   V6P1                                   21/08/2010
00073 !***********************************************************************
00074 !
00075 !
00076 !
00077 !
00078 !
00079 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00080 !| HMIN           |-->| MINIMUM VALUE OF DEPTH
00081 !| HN             |-->| WATER DEPTH AT TIME N
00082 !| IFABOR         |-->| ELEMENTS BEHIND THE EDGES OF A TRIANGLE
00083 !|                |   | IF NEGATIVE OR ZERO, THE EDGE IS A LIQUID
00084 !|                |   | BOUNDARY
00085 !| IKLE           |-->| CONNECTIVITY TABLE.
00086 !| ITRA01         |-->| WORK ARRAY OF INTEGERS
00087 !| MASKEL         |<--| MASKING OF ELEMENTS
00088 !|                |   | =1. : NORMAL   =0. : MASKED ELEMENT
00089 !| NELEM          |-->| NUMBER OF ELEMENTS
00090 !| NPOIN          |-->| NUMBER OF POINTS
00091 !| ZF             |-->| ELEVATION OF BOTTOM
00092 !| ZFE            |-->| ELEVATION OF BOTTOM, PER ELEMENT
00093 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00094 !
00095       IMPLICIT NONE
00096 !
00097 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00098 !
00099       INTEGER, INTENT(IN)             :: NELEM,NPOIN
00100       INTEGER, INTENT(IN)             :: IKLE(NELEM,3),IFABOR(NELEM,3)
00101       INTEGER, INTENT(INOUT)          :: ITRA01(NELEM)
00102       DOUBLE PRECISION, INTENT(IN)    :: ZFE(NELEM),ZF(NPOIN),HN(NPOIN)
00103       DOUBLE PRECISION, INTENT(IN)    :: HMIN
00104       DOUBLE PRECISION, INTENT(INOUT) :: MASKEL(NELEM)
00105 !
00106 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00107 !
00108       INTEGER IELEM,I1,I2,I3,N
00109 !
00110       DOUBLE PRECISION EPSILO,ZSE
00111 !
00112       LOGICAL FLAG
00113 !
00114       DATA EPSILO / 1.D-6 /
00115 !
00116 !-----------------------------------------------------------------------
00117 !
00118       FLAG = .FALSE.
00119 !
00120       DO IELEM = 1,NELEM
00121         I1 = IKLE(IELEM,1)
00122         I2 = IKLE(IELEM,2)
00123         I3 = IKLE(IELEM,3)
00124         ZSE = (ZF(I1)+HN(I1)+ZF(I2)+HN(I2)+ZF(I3)+HN(I3))/3.D0
00125         IF (ZFE(IELEM)+HMIN+EPSILO.GT.ZSE) THEN
00126           FLAG = .TRUE.
00127           MASKEL(IELEM) = 0.D0
00128         ENDIF
00129       ENDDO ! IELEM
00130 !
00131 20    CONTINUE
00132 !
00133       IF (FLAG) THEN
00134 !
00135         FLAG = .FALSE.
00136         DO IELEM = 1,NELEM
00137 !
00138           ITRA01(IELEM) = 0
00139           IF (MASKEL(IELEM).GT.0.5D0) THEN
00140 !
00141             N=IFABOR(IELEM,1)
00142             IF (N.GT.0) THEN
00143               IF (MASKEL(N).LT.0.5D0.AND.ZFE(IELEM).GT.
00144      &            ZFE(N)-EPSILO) ITRA01(IELEM) = 1
00145             ENDIF
00146             N=IFABOR(IELEM,2)
00147             IF (N.GT.0) THEN
00148               IF (MASKEL(N).LT.0.5D0.AND.ZFE(IELEM).GT.
00149      &            ZFE(N)-EPSILO) ITRA01(IELEM) = 1
00150             ENDIF
00151             N=IFABOR(IELEM,3)
00152             IF (N.GT.0) THEN
00153               IF (MASKEL(N).LT.0.5D0.AND.ZFE(IELEM).GT.
00154      &            ZFE(N)-EPSILO) ITRA01(IELEM) = 1
00155             ENDIF
00156 !
00157           ENDIF
00158 !
00159         ENDDO ! IELEM
00160 !
00161         DO IELEM = 1,NELEM
00162           IF (ITRA01(IELEM).EQ.1) THEN
00163             FLAG = .TRUE.
00164             MASKEL(IELEM) = 0.D0
00165           ENDIF
00166         ENDDO ! IELEM
00167 !
00168         GOTO 20
00169 !
00170       ENDIF
00171 !
00172 !-----------------------------------------------------------------------
00173 !
00174       RETURN
00175       END

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