cflp11.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\cflp11.f
00002 !
00050                      SUBROUTINE CFLP11
00051 !                    *****************
00052 !
00053      &(U,V,X,Y,IKLE,NELEM,NELMAX,W1)
00054 !
00055 !***********************************************************************
00056 ! BIEF   V6P1                                   21/08/2010
00057 !***********************************************************************
00058 !
00059 !
00060 !
00061 !
00062 !
00063 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00064 !| IKLE           |-->| CONNECTIVITY TABLE
00065 !| NELEM          |-->| NUMBER OF ELEMENTS IN THE MESH
00066 !| NELMAX         |-->| FIRST DIMENSION OF IKLE, MAXIMUM NUMBER OF ELEMENTS
00067 !|                |   | IN THE MESH
00068 !| U              |-->| VELOCITY ALONG X.
00069 !| V              |-->| VELOCITY ALONG Y.
00070 !| W1             |-->| RESULT IN NON ASSEMBLED FORM
00071 !| X              |-->| ABSCISSAE OF POINTS GIVEN PER ELEMENT
00072 !| Y              |-->| ORDINATES OF POINTS GIVEN PER ELEMENT
00073 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00074 !
00075       IMPLICIT NONE
00076       INTEGER LNG,LU
00077       COMMON/INFO/LNG,LU
00078 !
00079 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00080 !
00081       INTEGER         , INTENT(IN)  :: NELEM,NELMAX
00082       DOUBLE PRECISION, INTENT(IN)  :: U(*),V(*)
00083       DOUBLE PRECISION, INTENT(IN)  :: X(NELMAX,*),Y(NELMAX,*)
00084       INTEGER         , INTENT(IN)  :: IKLE(NELMAX,*)
00085       DOUBLE PRECISION, INTENT(OUT) :: W1(NELMAX,*)
00086 !
00087 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00088 !
00089       INTEGER IELEM
00090 !
00091       DOUBLE PRECISION U1,U2,U3,V1,V2,V3,USUR2,VSUR2
00092       DOUBLE PRECISION SUR6,K1,K2,K3,L12,L13,L21,L23,L31,L32
00093       DOUBLE PRECISION X2,X3,Y2,Y3
00094 !
00095       INTRINSIC MAX,MIN
00096 !
00097 !-----------------------------------------------------------------------
00098 !
00099       SUR6 = 1.D0 / 6.D0
00100 !
00101 ! LOOP ON THE ELEMENTS
00102 !
00103         DO IELEM = 1, NELEM
00104 !
00105           X2 = X(IELEM,2)
00106           X3 = X(IELEM,3)
00107           Y2 = Y(IELEM,2)
00108           Y3 = Y(IELEM,3)
00109 !
00110           U1 = U(IKLE(IELEM,1))
00111           U2 = U(IKLE(IELEM,2))
00112           U3 = U(IKLE(IELEM,3))
00113           V1 = V(IKLE(IELEM,1))
00114           V2 = V(IKLE(IELEM,2))
00115           V3 = V(IKLE(IELEM,3))
00116 !
00117           USUR2 = (U1+U2+U3)*SUR6
00118           VSUR2 = (V1+V2+V3)*SUR6
00119 !
00120           K1 = USUR2 * (Y2-Y3) - VSUR2 * (X2-X3)
00121           K2 = USUR2 * (Y3   ) - VSUR2 * (X3   )
00122           K3 = USUR2 * (  -Y2) - VSUR2 * (  -X2)
00123 !
00124           L12 = MAX(  MIN(K1,-K2) , 0.D0 )
00125           L13 = MAX(  MIN(K1,-K3) , 0.D0 )
00126           L21 = MAX(  MIN(K2,-K1) , 0.D0 )
00127           L23 = MAX(  MIN(K2,-K3) , 0.D0 )
00128           L31 = MAX(  MIN(K3,-K1) , 0.D0 )
00129           L32 = MAX(  MIN(K3,-K2) , 0.D0 )
00130 !
00131           W1(IELEM,1) = L12 + L13
00132           W1(IELEM,2) = L21 + L23
00133           W1(IELEM,3) = L31 + L32
00134 !
00135         ENDDO ! IELEM
00136 !
00137 !-----------------------------------------------------------------------
00138 !
00139       RETURN
00140       END

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