vc01oo.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\vc01oo.f
00002 !
00070                      SUBROUTINE VC01OO
00071 !                    *****************
00072 !
00073      &(XMUL,SF,F,LGSEG,IKLE1,IKLE2,NBOR,NELEM,NELMAX,W1,W2)
00074 !
00075 !***********************************************************************
00076 ! BIEF   V6P1                                   21/08/2010
00077 !***********************************************************************
00078 !
00079 !
00080 !
00081 !
00082 !
00083 !
00084 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00085 !| F              |-->| FUNCTION USED IN THE VECTOR FORMULA
00086 !| IKLE1          |-->| FIRST POINT OF SEGMENTS
00087 !| IKLE2          |-->| SECOND POINT OF SEGMENTS
00088 !| LGSEG          |-->| LENGTH OF SEGMENTS
00089 !| NBOR           |-->| GLOBAL NUMBER OF BOUNDARY POINTS
00090 !| NELEM          |-->| NUMBER OF ELEMENTS
00091 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00092 !| SF             |-->| BIEF_OBJ STRUCTURE OF F
00093 !| W1             |<--| RESULT IN NON ASSEMBLED FORM
00094 !| W2             |<--| RESULT IN NON ASSEMBLED FORM
00095 !| XMUL           |-->| MULTIPLICATION COEFFICIENT
00096 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00097 !
00098       USE BIEF, EX_VC01OO => VC01OO
00099 !
00100       IMPLICIT NONE
00101       INTEGER LNG,LU
00102       COMMON/INFO/LNG,LU
00103 !
00104 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00105 !
00106       INTEGER, INTENT(IN) :: NELEM,NELMAX
00107       INTEGER, INTENT(IN) :: IKLE1(NELMAX),IKLE2(NELMAX)
00108       INTEGER, INTENT(IN) :: NBOR(*)
00109 !
00110       DOUBLE PRECISION, INTENT(INOUT) :: W1(NELMAX),W2(NELMAX)
00111       DOUBLE PRECISION, INTENT(IN)    :: LGSEG(NELMAX)
00112       DOUBLE PRECISION, INTENT(IN)    :: XMUL
00113 !
00114 !     STRUCTURE OF F AND REAL DATA
00115 !
00116       TYPE(BIEF_OBJ), INTENT(IN) :: SF
00117       DOUBLE PRECISION, INTENT(IN) :: F(*)
00118 !
00119 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00120 !
00121       INTEGER IELEM,IELMF
00122       DOUBLE PRECISION XSUR3,XSUR6,F1,F2,V1,V2
00123 !
00124 !-----------------------------------------------------------------------
00125 !
00126       IELMF=SF%ELM
00127 !
00128 !-----------------------------------------------------------------------
00129 !
00130 !     F IS CONSTANT BY SEGMENTS
00131 !
00132       IF(IELMF.EQ.0) THEN
00133 !
00134       DO IELEM = 1,NELEM
00135         W1(IELEM) = 0.5D0*XMUL*F(IELEM)*LGSEG(IELEM)
00136         W2(IELEM) = W1(IELEM)
00137       ENDDO
00138 !
00139 !-----------------------------------------------------------------------
00140 !
00141 !     F IS LINEAR BY SEGMENTS
00142 !
00143       ELSEIF(IELMF.EQ.1) THEN
00144 !
00145       XSUR3 = XMUL/3.D0
00146       XSUR6 = XMUL/6.D0
00147 !
00148       DO IELEM = 1,NELEM
00149         F1 = F(IKLE1(IELEM))
00150         F2 = F(IKLE2(IELEM))
00151         V1 = ( F1*XSUR3 + F2*XSUR6 )
00152         V2 = ( F2*XSUR3 + F1*XSUR6 )
00153         W1(IELEM) = V1 * LGSEG(IELEM)
00154         W2(IELEM) = V2 * LGSEG(IELEM)
00155       ENDDO
00156 !
00157 !-----------------------------------------------------------------------
00158 !
00159 !     F IS LINEAR BY TRIANGLES OR QUADRILATERALS OR QUASI-BUBBLE
00160 !
00161       ELSEIF(IELMF.EQ.11.OR.IELMF.EQ.12.OR.IELMF.EQ.21) THEN
00162 !
00163       XSUR3 = XMUL/3.D0
00164       XSUR6 = XMUL/6.D0
00165 !
00166       DO IELEM = 1,NELEM
00167         F1 = F(NBOR(IKLE1(IELEM)))
00168         F2 = F(NBOR(IKLE2(IELEM)))
00169         V1 = ( F1*XSUR3 + F2*XSUR6 )
00170         V2 = ( F2*XSUR3 + F1*XSUR6 )
00171         W1(IELEM) = V1 * LGSEG(IELEM)
00172         W2(IELEM) = V2 * LGSEG(IELEM)
00173       ENDDO
00174 !
00175 !-----------------------------------------------------------------------
00176 !
00177       ELSE
00178 !
00179 !-----------------------------------------------------------------------
00180 !
00181         IF (LNG.EQ.1) WRITE(LU,100) IELMF,SF%NAME
00182         IF (LNG.EQ.2) WRITE(LU,101) IELMF,SF%NAME
00183 100     FORMAT(1X,'VC01OO (BIEF) :',/,
00184      &         1X,'DISCRETISATION DE F NON PREVUE : ',1I6,
00185      &         1X,'NOM REEL : ',A6)
00186 101     FORMAT(1X,'VC01OO (BIEF) :',/,
00187      &         1X,'DISCRETIZATION OF F NOT AVAILABLE:',1I6,
00188      &         1X,'REAL NAME: ',A6)
00189         CALL PLANTE(1)
00190         STOP
00191 !
00192       ENDIF
00193 !
00194 !-----------------------------------------------------------------------
00195 !
00196       RETURN
00197       END

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