vc00ft.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\vc00ft.f
00002 !
00058                      SUBROUTINE VC00FT
00059 !                    *****************
00060 !
00061      &(XMUL,X,Y,Z,IKLE1,IKLE2,IKLE3,NBOR,NELEM,NELMAX,W1,W2,W3)
00062 !
00063 !***********************************************************************
00064 ! BIEF   V6P1                                   21/08/2010
00065 !***********************************************************************
00066 !
00067 !
00068 !
00069 !
00070 !
00071 !
00072 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00073 !| IKLE1          |-->| FIRST POINT OF TRIANGLES
00074 !| IKLE2          |-->| SECOND POINT OF TRIANGLES
00075 !| IKLE3          |-->| THIRD POINT OF TRIANGLES
00076 !| NBOR           |-->| GLOBAL NUMBER OF BOUNDARY POINTS
00077 !| NELEM          |-->| NUMBER OF ELEMENTS
00078 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00079 !| W1             |<--| RESULT IN NON ASSEMBLED FORM
00080 !| W2             |<--| RESULT IN NON ASSEMBLED FORM
00081 !| W3             |<--| RESULT IN NON ASSEMBLED FORM
00082 !| X              |-->| ABSCISSAE OF POINTS IN THE MESH
00083 !| XMUL           |-->| MULTIPLICATION COEFFICIENT
00084 !| Y              |-->| ORDINATES OF POINTS IN THE MESH
00085 !| Z              |-->| ELEVATIONS OF POINTS IN THE MESH
00086 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00087 !
00088       IMPLICIT NONE
00089       INTEGER LNG,LU
00090       COMMON/INFO/LNG,LU
00091 !
00092 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00093 !
00094       INTEGER, INTENT(IN) :: NELEM,NELMAX
00095       INTEGER, INTENT(IN) :: NBOR(*)
00096       INTEGER, INTENT(IN) :: IKLE1(NELMAX),IKLE2(NELMAX),IKLE3(NELMAX)
00097 !
00098       DOUBLE PRECISION, INTENT(IN)    :: X(*),Y(*),Z(*)
00099       DOUBLE PRECISION, INTENT(INOUT) :: W1(NELMAX)
00100       DOUBLE PRECISION, INTENT(INOUT) :: W2(NELMAX)
00101       DOUBLE PRECISION, INTENT(INOUT) :: W3(NELMAX)
00102       DOUBLE PRECISION, INTENT(IN)    :: XMUL
00103 !
00104 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00105 !
00106       INTEGER IELEM,I1,I2,I3
00107       DOUBLE PRECISION XSUR3,COEF,X1,X2,X3,Y1,Y2
00108       DOUBLE PRECISION Y3,Z1,Z2,Z3,S
00109 !
00110       INTRINSIC SQRT
00111 !
00112 !***********************************************************************
00113 !
00114       XSUR3 = XMUL/3.D0
00115 !
00116 !   LOOP ON THE BOUNDARY SIDES
00117 !
00118       DO IELEM = 1,NELEM
00119 !
00120 !       GLOBAL NUMBERING OF THE SIDE NODES
00121 !
00122         I1 = NBOR(IKLE1(IELEM))
00123         I2 = NBOR(IKLE2(IELEM))
00124         I3 = NBOR(IKLE3(IELEM))
00125 !
00126         X1 = X(I1)
00127         Y1 = Y(I1)
00128         Z1 = Z(I1)
00129 !
00130         X2 = X(I2)-X1
00131         X3 = X(I3)-X1
00132         Y2 = Y(I2)-Y1
00133         Y3 = Y(I3)-Y1
00134         Z2 = Z(I2)-Z1
00135         Z3 = Z(I3)-Z1
00136 !
00137 !       COMPUTES THE AREA OF THE TRIANGLE (BY VECTOR PRODUCT)
00138 !
00139         S=0.5D0*SQRT(  (Y2*Z3-Y3*Z2)**2
00140      &                +(X3*Z2-X2*Z3)**2  )
00141 !    &                +(X2*Y3-X3*Y2)**2  )  THIS TERM IS 0
00142 !
00143         COEF=XSUR3*S
00144 !
00145         W1(IELEM) = COEF
00146         W2(IELEM) = COEF
00147         W3(IELEM) = COEF
00148 !
00149       ENDDO ! IELEM
00150 !
00151 !-----------------------------------------------------------------------
00152 !
00153 !
00154 !-----------------------------------------------------------------------
00155 !
00156 !     NOTE: FOR A PLANE TRIANGLE (VC00AA):
00157 !
00158 !     XSUR3 = XMUL / 3.D0
00159 !
00160 !     DO IELEM = 1 , NELEM
00161 !
00162 !
00163 !       COEF = XSUR3 * SURFAC(IELEM)
00164 !
00165 !       W1(IELEM) = COEF
00166 !       W2(IELEM) = COEF
00167 !       W3(IELEM) = COEF
00168 !
00169 !     ENDDO ! IELEM
00170 !
00171 !-----------------------------------------------------------------------
00172 !
00173       RETURN
00174       END

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