cflp12.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\cflp12.f
00002 !
00055                      SUBROUTINE CFLP12
00056 !                    *****************
00057 !
00058      &(U,V,X,Y,IKLE,NELEM,NELMAX,W1)
00059 !
00060 !***********************************************************************
00061 ! BIEF   V6P1                                   21/08/2010
00062 !***********************************************************************
00063 !
00064 !
00065 !
00066 !
00067 !
00068 !
00069 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00070 !| IKLE           |-->| CONNECTIVITY TABLE
00071 !| NELEM          |-->| NUMBER OF ELEMENTS IN THE MESH
00072 !| NELMAX         |-->| FIRST DIMENSION OF IKLE, MAXIMUM NUMBER OF ELEMENTS
00073 !|                |   | IN THE MESH
00074 !| U              |-->| VELOCITY ALONG X.
00075 !| V              |-->| VELOCITY ALONG Y.
00076 !| W1             |-->| RESULT IN NON ASSEMBLED FORM
00077 !| X              |-->| ABSCISSAE OF POINTS GIVEN PER ELEMENT
00078 !| Y              |-->| ORDINATES OF POINTS GIVEN PER ELEMENT
00079 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00080 !
00081       IMPLICIT NONE
00082       INTEGER LNG,LU
00083       COMMON/INFO/LNG,LU
00084 !
00085 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00086 !
00087       INTEGER         , INTENT(IN)  :: NELEM,NELMAX
00088       DOUBLE PRECISION, INTENT(IN)  :: U(*),V(*)
00089       DOUBLE PRECISION, INTENT(IN)  :: X(NELMAX*3),Y(NELMAX*3)
00090       INTEGER         , INTENT(IN)  :: IKLE(NELMAX*4)
00091       DOUBLE PRECISION, INTENT(OUT) :: W1(NELMAX*4)
00092 !
00093 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00094 !
00095       INTEGER IELEM,IT,IAD1,IAD2,IAD3,IG1,IG2,IG3
00096 !
00097       DOUBLE PRECISION USUR2,VSUR2
00098       DOUBLE PRECISION SUR6,K1,K2,K3,L12,L13,L21,L23,L31,L32
00099       DOUBLE PRECISION X1,X2,X3,Y1,Y2,Y3,TIERS
00100 !
00101       INTRINSIC MAX,MIN
00102 !
00103 !-----------------------------------------------------------------------
00104 !
00105 !     FOR A QUASI-BUBBLE TRIANGLE : NUMBERS OF THE VERTICES OF THE
00106 !     SUB-TRIANGLES IN THE INITIAL TRIANGLE
00107 !     IL(NUMBER OF THE SUB-TRIANGLE,LOCAL NUMBER IN THE SUB-TRIANGLE)
00108 !
00109       INTEGER IL(3,3)
00110       DATA IL /1,2,3,2,3,1,4,4,4/
00111 !
00112 !-----------------------------------------------------------------------
00113 !
00114       TIERS= 1.D0 / 3.D0
00115       SUR6 = 1.D0 / 6.D0
00116 !
00117 !     INITIALISES W
00118 !
00119       DO IELEM = 1 , 4*NELMAX
00120         W1(IELEM) = 0.D0
00121       ENDDO ! IELEM
00122 !
00123 !     USING THE PSI SCHEME,
00124 !     LOOP ON THE 3 SUB-TRIANGLES AND PRE-ASSEMBLY
00125 !
00126       DO IT=1,3
00127       DO IELEM = 1 , NELEM
00128 !
00129 !       ADDRESSES IN AN ARRAY (NELMAX,*)
00130         IAD1= IELEM + (IL(IT,1)-1)*NELMAX
00131         IAD2= IELEM + (IL(IT,2)-1)*NELMAX
00132         IAD3= IELEM + (IL(IT,3)-1)*NELMAX
00133 !       GLOBAL NUMBERS IN THE INITIAL TRIANGLE
00134         IG1 = IKLE(IAD1)
00135         IG2 = IKLE(IAD2)
00136         IG3 = IKLE(IAD3)
00137 !       COORDINATES OF THE SUB-TRIANGLE VERTICES
00138         X1 = X(IAD1)
00139         X2 = X(IAD2) - X1
00140         Y1 = Y(IAD1)
00141         Y2 = Y(IAD2) - Y1
00142 !       POINT 3 IS ALWAYS AT THE CENTRE OF THE INITIAL TRIANGLE
00143         X3=TIERS*(X(IELEM)+X(IELEM+NELMAX)+X(IELEM+2*NELMAX))-X1
00144         Y3=TIERS*(Y(IELEM)+Y(IELEM+NELMAX)+Y(IELEM+2*NELMAX))-Y1
00145 !
00146         USUR2 = (U(IG1)+U(IG2)+U(IG3))*SUR6
00147         VSUR2 = (V(IG1)+V(IG2)+V(IG3))*SUR6
00148 !
00149         K1 = USUR2 * (Y2-Y3) - VSUR2 * (X2-X3)
00150         K2 = USUR2 * (Y3   ) - VSUR2 * (X3   )
00151         K3 = USUR2 * (  -Y2) - VSUR2 * (  -X2)
00152 !
00153         L12 = MAX(  MIN(K1,-K2) , 0.D0 )
00154         L13 = MAX(  MIN(K1,-K3) , 0.D0 )
00155         L21 = MAX(  MIN(K2,-K1) , 0.D0 )
00156         L23 = MAX(  MIN(K2,-K3) , 0.D0 )
00157         L31 = MAX(  MIN(K3,-K1) , 0.D0 )
00158         L32 = MAX(  MIN(K3,-K2) , 0.D0 )
00159 !
00160         W1(IAD1) = W1(IAD1) + L12 + L13
00161         W1(IAD2) = W1(IAD2) + L21 + L23
00162         W1(IAD3) = W1(IAD3) + L31 + L32
00163 !
00164       ENDDO ! IELEM
00165       ENDDO ! IT
00166 !
00167 !-----------------------------------------------------------------------
00168 !
00169       RETURN
00170       END

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