kspg11.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\kspg11.f
00002 !
00071                      SUBROUTINE KSPG11
00072 !                    *****************
00073 !
00074      &(KX,KY,XEL,YEL,U,V,IKLE,NELEM,NELMAX,XMUL)
00075 !
00076 !***********************************************************************
00077 ! BIEF   V6P1                                   21/08/2010
00078 !***********************************************************************
00079 !
00080 !
00081 !
00082 !
00083 !
00084 !
00085 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00086 !| IKLE           |-->| CONNECTIVITY TABLE.
00087 !| KX             |-->| FIRST COMPONENT OF RESULTING VECTOR
00088 !| KY             |-->| SECOND COMPONENT OF RESULTING VECTOR
00089 !| NELEM          |-->| NUMBER OF ELEMENTS
00090 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00091 !| U              |-->| FIRST COMPONENT OF VELOCITY
00092 !| V              |-->| SECOND COMPONENT OF VELOCITY
00093 !| XMUL           |-->| MULTIPLICATION COEFICIENT
00094 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00095 !
00096       IMPLICIT NONE
00097       INTEGER LNG,LU
00098       COMMON/INFO/LNG,LU
00099 !
00100 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00101 !
00102       INTEGER, INTENT(IN)             :: NELEM,NELMAX
00103       INTEGER, INTENT(IN)             :: IKLE(NELMAX,*)
00104       DOUBLE PRECISION, INTENT(INOUT) :: KX(NELEM),KY(NELEM)
00105       DOUBLE PRECISION, INTENT(IN)    :: U(*),V(*),XMUL
00106       DOUBLE PRECISION, INTENT(IN)    :: XEL(NELMAX,*),YEL(NELMAX,*)
00107 !
00108 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00109 !
00110       INTEGER IELEM,I1,I2,I3
00111 !
00112       DOUBLE PRECISION UMOY,VMOY,H,SUNORM,X2,X3,Y2,Y3
00113       DOUBLE PRECISION SURFAC,GP1X,GP1Y,GP2X,GP2Y,GP3X,GP3Y
00114       DOUBLE PRECISION A1,A2,A3,H1,H2,H3,C1,C2,C3,UNORM,VNORM
00115 !
00116       INTRINSIC MAX,SQRT
00117 !
00118 !-----------------------------------------------------------------------
00119 !
00120       DO IELEM = 1 , NELEM
00121 !
00122         I1 = IKLE(IELEM,1)
00123         I2 = IKLE(IELEM,2)
00124         I3 = IKLE(IELEM,3)
00125 !
00126         X2 = XEL(IELEM,2)
00127         X3 = XEL(IELEM,3)
00128         Y2 = YEL(IELEM,2)
00129         Y3 = YEL(IELEM,3)
00130 !
00131         GP1X = Y2-Y3
00132         GP1Y = X3-X2
00133         SUNORM = 1.D0 / SQRT(GP1X**2+GP1Y**2)
00134         GP1X = GP1X * SUNORM
00135         GP1Y = GP1Y * SUNORM
00136 !
00137         GP2X = Y3
00138         GP2Y =   -X3
00139         SUNORM = 1.D0 / SQRT(GP2X**2+GP2Y**2)
00140         GP2X = GP2X * SUNORM
00141         GP2Y = GP2Y * SUNORM
00142 !
00143         GP3X =   -Y2
00144         GP3Y = X2
00145         SUNORM = 1.D0 / SQRT(GP3X**2+GP3Y**2)
00146         GP3X = GP3X * SUNORM
00147         GP3Y = GP3Y * SUNORM
00148 !
00149         C3 = SQRT(  X2**2     +  Y2**2 )
00150         C1 = SQRT( (X3-X2)**2 + (Y3-Y2)**2 )
00151         C2 = SQRT(  X3**2     +  Y3**2 )
00152 !
00153         SURFAC = 0.5D0 * (X2*Y3 - X3*Y2)
00154 !
00155         H1 = 2*SURFAC/C1
00156         H2 = 2*SURFAC/C2
00157         H3 = 2*SURFAC/C3
00158 !
00159         H = MAX(H1,H2,H3)
00160 !
00161         UMOY = U(I1) + U(I2) + U(I3)
00162         VMOY = V(I1) + V(I2) + V(I3)
00163 !
00164         SUNORM = 1.D0 / MAX ( SQRT(UMOY**2+VMOY**2) , 1.D-10 )
00165 !
00166         UNORM = UMOY * SUNORM
00167         VNORM = VMOY * SUNORM
00168 !
00169         A1 = GP1X * UNORM + GP1Y * VNORM
00170         A2 = GP2X * UNORM + GP2Y * VNORM
00171         A3 = GP3X * UNORM + GP3Y * VNORM
00172 !
00173         IF(A1*H.GT.H1) H = H1
00174         IF(A2*H.GT.H2) H = H2
00175         IF(A3*H.GT.H3) H = H3
00176 !
00177         KX(IELEM) = 0.33333333D0 * XMUL * H * UNORM
00178         KY(IELEM) = 0.33333333D0 * XMUL * H * VNORM
00179 !
00180       ENDDO ! IELEM
00181 !
00182 !-----------------------------------------------------------------------
00183 !
00184       RETURN
00185       END

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