vc08cc.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\vc08cc.f
00002 !
00068                      SUBROUTINE VC08CC
00069 !                    *****************
00070 !
00071      &(XMUL,SF,SU,SV,F,U,V,XEL,YEL,
00072      & IKLE1,IKLE2,IKLE3,IKLE4,IKLE5,IKLE6,NELEM,NELMAX,
00073      & W1,W2,W3,W4,W5,W6,FORMUL)
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 !| FORMUL         |-->| STRING WITH FORMULA OF VECTOR
00087 !| IKLE1          |-->| FIRST POINT OF TRIANGLES
00088 !| IKLE2          |-->| SECOND POINT OF TRIANGLES
00089 !| IKLE3          |-->| THIRD POINT OF TRIANGLES
00090 !| IKLE4          |-->| FOURTH POINT OF TRIANGLES (QUADRATIC)
00091 !| IKLE5          |-->| FIFTH POINT OF TRIANGLES (QUADRATIC)
00092 !| IKLE6          |-->| SIXTH POINT OF TRIANGLES (QUADRATIC)
00093 !| NELEM          |-->| NUMBER OF ELEMENTS
00094 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00095 !| SF             |-->| BIEF_OBJ STRUCTURE OF F
00096 !| SU             |-->| BIEF_OBJ STRUCTURE OF U
00097 !| SV             |-->| BIEF_OBJ STRUCTURE OF V
00098 !| U              |-->| FUNCTION USED IN THE VECTOR FORMULA
00099 !| V              |-->| FUNCTION USED IN THE VECTOR FORMULA
00100 !| W1             |<--| RESULT IN NON ASSEMBLED FORM
00101 !| W2             |<--| RESULT IN NON ASSEMBLED FORM
00102 !| W3             |<--| RESULT IN NON ASSEMBLED FORM
00103 !| W4             |<--| RESULT IN NON ASSEMBLED FORM
00104 !| W5             |<--| RESULT IN NON ASSEMBLED FORM
00105 !| W6             |<--| RESULT IN NON ASSEMBLED FORM
00106 !| XEL            |-->| ABSCISSAE OF POINTS IN THE MESH, PER ELEMENT
00107 !| XMUL           |-->| MULTIPLICATION COEFFICIENT
00108 !| YEL            |-->| ORDINATES OF POINTS IN THE MESH, PER ELEMENT
00109 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00110 !
00111       USE BIEF, EX_VC08CC => VC08CC
00112 !
00113       IMPLICIT NONE
00114       INTEGER LNG,LU
00115       COMMON/INFO/LNG,LU
00116 !
00117 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00118 !
00119       INTEGER, INTENT(IN) :: NELEM,NELMAX
00120       DOUBLE PRECISION, INTENT(IN) :: XEL(NELMAX*3),YEL(NELMAX*3),XMUL
00121 !     W1 IS ALSO USED AS 1-DIMENSIONAL FOR ALL W
00122       DOUBLE PRECISION, INTENT(INOUT) :: W1(6*NELMAX),W2(NELMAX)
00123       DOUBLE PRECISION, INTENT(INOUT) :: W3(NELMAX),W4(NELMAX)
00124       DOUBLE PRECISION, INTENT(INOUT) :: W5(NELMAX),W6(NELMAX)
00125 !     IKLE1 IS ALSO USED AS A 1-DIMENSIONAL IKLE
00126       INTEGER, INTENT(IN) :: IKLE1(6*NELMAX),IKLE2(NELMAX)
00127       INTEGER, INTENT(IN) :: IKLE3(NELMAX),IKLE4(NELMAX)
00128       INTEGER, INTENT(IN) :: IKLE5(NELMAX),IKLE6(NELMAX)
00129       CHARACTER(LEN=16), INTENT(IN) :: FORMUL
00130 !
00131 !     STRUCTURES OF F, G, H, U, V, W AND REAL DATA
00132 !
00133       TYPE(BIEF_OBJ), INTENT(IN) :: SF,SU,SV
00134       DOUBLE PRECISION, INTENT(IN) :: F(*),U(*),V(*)
00135 !
00136 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00137 !
00138       INTEGER IELEM,IELMF,IELMU,IELMV
00139 !
00140       DOUBLE PRECISION K1,K2,K3
00141 !
00142 !-----------------------------------------------------------------------
00143 !
00144       DOUBLE PRECISION X2,Y2,X3,Y3,F1,F2,F3,F4,F5,F6
00145       DOUBLE PRECISION U1,U2,U3,U4,U5,U6,V1,V2,V3,V4,V5,V6
00146       DOUBLE PRECISION ANS1,SUR6
00147       DOUBLE PRECISION PHIT,USUR2,VSUR2,XSU90,XSU360,XSU630,XSU2520
00148       DOUBLE PRECISION L12,L13,L21,L23,L31,L32,BETAN1,BETAN2,BETAN3
00149       INTRINSIC MAX,MIN
00150 !
00151 !-----------------------------------------------------------------------
00152 !
00153       SUR6   = 1.D0 / 6.D0
00154       XSU90  = XMUL/90.D0
00155       XSU360 = XMUL/360.D0
00156       XSU630 = XMUL/630.D0
00157       XSU2520= XMUL/2520.D0
00158 !
00159       IELMF=SF%ELM
00160       IELMU=SU%ELM
00161       IELMV=SV%ELM
00162 !
00163 !-----------------------------------------------------------------------
00164 !
00165 !     FUNCTION F AND VECTOR U ARE P2
00166 !
00167       IF(IELMF.EQ.13.AND.IELMU.EQ.13.AND.IELMV.EQ.13) THEN
00168 !
00169       IF(FORMUL(14:16).EQ.'PSI') THEN
00170 !
00171 !     PSI SCHEME P1 AND LINEAR INTERPOLATION
00172 !
00173       DO IELEM = 1 , NELEM
00174 !
00175         X2 = XEL(IELEM+NELMAX)
00176         X3 = XEL(IELEM+2*NELMAX)
00177         Y2 = YEL(IELEM+NELMAX)
00178         Y3 = YEL(IELEM+2*NELMAX)
00179 !
00180         F1 = F(IKLE1(IELEM))
00181         F2 = F(IKLE2(IELEM))
00182         F3 = F(IKLE3(IELEM))
00183 !
00184         U1 = U(IKLE1(IELEM))
00185         U2 = U(IKLE2(IELEM))
00186         U3 = U(IKLE3(IELEM))
00187         V1 = V(IKLE1(IELEM))
00188         V2 = V(IKLE2(IELEM))
00189         V3 = V(IKLE3(IELEM))
00190 !
00191         USUR2 = (U1+U2+U3)*SUR6
00192         VSUR2 = (V1+V2+V3)*SUR6
00193 !
00194         K1 = USUR2 * (Y2-Y3) - VSUR2 * (X2-X3)
00195         K2 = USUR2 * (Y3   ) - VSUR2 * (X3   )
00196         K3 = USUR2 * (  -Y2) - VSUR2 * (  -X2)
00197 !
00198         L12 = MAX(  MIN(K1,-K2) , 0.D0 )
00199         L13 = MAX(  MIN(K1,-K3) , 0.D0 )
00200         L21 = MAX(  MIN(K2,-K1) , 0.D0 )
00201         L23 = MAX(  MIN(K2,-K3) , 0.D0 )
00202         L31 = MAX(  MIN(K3,-K1) , 0.D0 )
00203         L32 = MAX(  MIN(K3,-K2) , 0.D0 )
00204 !
00205         BETAN1 = L12*(F1-F2) + L13*(F1-F3)
00206         BETAN2 = L21*(F2-F1) + L23*(F2-F3)
00207         BETAN3 = L31*(F3-F1) + L32*(F3-F2)
00208 !
00209         PHIT = BETAN1 + BETAN2 + BETAN3
00210 !
00211         IF(PHIT.GT.0.D0) THEN
00212           W1(IELEM) =   XMUL * MAX( MIN( BETAN1, PHIT),0.D0 )
00213           W2(IELEM) =   XMUL * MAX( MIN( BETAN2, PHIT),0.D0 )
00214           W3(IELEM) =   XMUL * MAX( MIN( BETAN3, PHIT),0.D0 )
00215         ELSE
00216           W1(IELEM) = - XMUL * MAX( MIN(-BETAN1,-PHIT),0.D0 )
00217           W2(IELEM) = - XMUL * MAX( MIN(-BETAN2,-PHIT),0.D0 )
00218           W3(IELEM) = - XMUL * MAX( MIN(-BETAN3,-PHIT),0.D0 )
00219         ENDIF
00220         W4(IELEM) =   (W1(IELEM)+ W2(IELEM))/2.D0
00221         W5(IELEM) =   (W2(IELEM)+ W3(IELEM))/2.D0
00222         W6(IELEM) =   (W3(IELEM)+ W1(IELEM))/2.D0
00223 !
00224       ENDDO ! IELEM
00225 !
00226       ELSE
00227 !
00228 !     CLASSICAL COMPUTATION
00229 !
00230       DO IELEM = 1 , NELEM
00231 !
00232         X2 = XEL(IELEM+NELMAX)
00233         X3 = XEL(IELEM+2*NELMAX)
00234         Y2 = YEL(IELEM+NELMAX)
00235         Y3 = YEL(IELEM+2*NELMAX)
00236 !
00237         U1 = U(IKLE1(IELEM))
00238         U2 = U(IKLE2(IELEM))
00239         U3 = U(IKLE3(IELEM))
00240         U4 = U(IKLE4(IELEM))
00241         U5 = U(IKLE5(IELEM))
00242         U6 = U(IKLE6(IELEM))
00243 !
00244         V1 = V(IKLE1(IELEM))
00245         V2 = V(IKLE2(IELEM))
00246         V3 = V(IKLE3(IELEM))
00247         V4 = V(IKLE4(IELEM))
00248         V5 = V(IKLE5(IELEM))
00249         V6 = V(IKLE6(IELEM))
00250 !
00251         F1 = F(IKLE1(IELEM))
00252         F2 = F(IKLE2(IELEM)) - F1
00253         F3 = F(IKLE3(IELEM)) - F1
00254         F4 = F(IKLE4(IELEM)) - F1
00255         F5 = F(IKLE5(IELEM)) - F1
00256         F6 = F(IKLE6(IELEM)) - F1
00257 !
00258       ANS1 =-20.D0*Y2*F3*U5-64.D0*X2*F6*V4+16.D0*Y2*F4*U6+
00259      &       16.D0*X3*F6*V4+4.D0*Y2*F5*U3-32.D0*Y3*F4*U5-16.D0*X2*F4*V6-
00260      &       16.D0*Y2*F3*U4+32.D0*X3*F4*V5-32.D0*X2*F4*V4-
00261      &       24.D0*Y2*F4*U1+24.D0*Y2*F5*U1-80.D0*Y3*F4*U4-
00262      &       24.D0*X2*F5*V1+16.D0*X2*F3*V4-9.D0*X3*F2*V2+
00263      &       80.D0*X3*F4*V4-16.D0*Y3*F6*U4+9.D0*X2*F3*V3+
00264      &       4.D0*Y3*F6*U2-48.D0*X2*F4*V5-32.D0*Y3*F6*U6-
00265      &       32.D0*Y2*F5*U4+32.D0*Y3*F2*U4-16.D0*Y2*F5*U6+
00266      &       11.D0*X3*F2*V3+24.D0*Y3*F6*U1+16.D0*X2*F5*V6-
00267      &       64.D0*Y3*F4*U6-48.D0*Y3*F6*U5+4.D0*X2*F4*V3-
00268      &       48.D0*X3*F5*V5-18.D0*X3*F2*V1+16.D0*Y3*F2*U6+
00269      &       32.D0*Y2*F4*U4+20.D0*Y3*F4*U3+11.D0*Y2*F3*U2+
00270      &       20.D0*Y3*F2*U5-4.D0*X3*F6*V2+32.D0*X2*F5*V4-11.D0*X2*F3*V2-
00271      &       32.D0*X3*F2*V4-9.D0*Y2*F3*U3+96.D0*Y2*F6*U1+9.D0*Y3*F2*U2-
00272      &       24.D0*X3*F6*V1+32.D0*Y3*F5*U6-24.D0*Y3*F5*U1+
00273      &       48.D0*Y2*F4*U5+96.D0*X3*F4*V1-48.D0*Y2*F5*U5+
00274      &       48.D0*X2*F5*V5-32.D0*X3*F5*V6-20.D0*X3*F2*V5+4.D0*X3*F5*V2+
00275      &       64.D0*X3*F4*V6-16.D0*X2*F4*V2+18.D0*X2*F3*V1+
00276      &       24.D0*X3*F5*V1-96.D0*X2*F6*V1+32.D0*X3*F6*V6-
00277      &       11.D0*Y3*F2*U3-4.D0*X2*F5*V3+20.D0*X2*F3*V5+16.D0*Y3*F5*U3
00278       W1(IELEM) =( -16.D0*Y3*F6*U3-20.D0*X3*F4*V3-16.D0*X3*F5*V3-
00279      &              16.D0*Y2*F5*U2+16.D0*Y2*F4*U2+16.D0*X2*F5*V2-
00280      &              20.D0*Y2*F6*U2+32.D0*Y2*F6*U5+20.D0*X2*F6*V2+
00281      &              80.D0*Y2*F6*U6-96.D0*Y3*F4*U1-80.D0*X2*F6*V6-
00282      &              32.D0*X2*F6*V5-18.D0*Y2*F3*U1-4.D0*Y2*F4*U3+
00283      &              32.D0*X2*F3*V6+16.D0*X3*F6*V3-32.D0*Y2*F3*U6-
00284      &              16.D0*X3*F2*V6-4.D0*Y3*F5*U2+24.D0*X2*F4*V1+
00285      &              64.D0*Y2*F6*U4+16.D0*Y3*F5*U4+48.D0*Y3*F5*U5+
00286      &              48.D0*X3*F6*V5+18.D0*Y3*F2*U1-16.D0*X3*F5*V4+
00287      &              ANS1) * (-XSU2520)
00288 !
00289       ANS1 = 32.D0*Y2*F3*U5-16.D0*X2*F6*V4-16.D0*Y2*F4*U6-16.D0*X3*F6*V4
00290      &+16.D0*Y2*F5*U3-64.D0*Y3*F4*U5+16.D0*X2*F4*V6+16.D0*Y2*F3*U4
00291      &+64.D0*X3*F4*V5-48.D0*X2*F4*V4-16.D0*Y2*F4*U1+16.D0*Y2*F5*U1
00292      &-80.D0*Y3*F4*U4-96.D0*Y3*F4*U2-16.D0*X2*F5*V1-16.D0*X2*F3*V4
00293      &-78.D0*X3*F2*V2+80.D0*X3*F4*V4+16.D0*Y3*F6*U4-9.D0*X2*F3*V3
00294      &-24.D0*Y3*F6*U2-48.D0*X2*F4*V5+48.D0*Y3*F6*U6-48.D0*Y2*F5*U4
00295      &+48.D0*Y3*F2*U4+16.D0*Y2*F5*U6+9.D0*X3*F2*V3-4.D0*Y3*F6*U1
00296      &-16.D0*X2*F5*V6-32.D0*Y3*F4*U6+32.D0*Y3*F6*U5+16.D0*X2*F4*V3
00297      &+32.D0*X3*F5*V5+9.D0*X3*F2*V1+12.D0*Y3*F2*U6-20.D0*Y2*F6*U3
00298      &+48.D0*Y2*F4*U4+20.D0*Y3*F4*U3+18.D0*Y2*F3*U2+48.D0*Y3*F2*U5
00299      &+24.D0*X3*F6*V2+48.D0*X2*F5*V4-18.D0*X2*F3*V2-48.D0*X3*F2*V4
00300      &+96.D0*X3*F4*V2+9.D0*Y2*F3*U3+20.D0*Y2*F6*U1+78.D0*Y3*F2*U2
00301      &+4.D0*X3*F6*V1-48.D0*Y3*F5*U6+4.D0*Y3*F5*U1+48.D0*Y2*F4*U5
00302      &-48.D0*Y2*F5*U5+48.D0*X2*F5*V5+48.D0*X3*F5*V6-48.D0*X3*F2*V5
00303      &-24.D0*X3*F5*V2+32.D0*X3*F4*V6-120.D0*X2*F4*V2+11.D0*X2*F3*V1
00304      &-4.D0*X3*F5*V1-20.D0*X2*F6*V1-48.D0*X3*F6*V6-9.D0*Y3*F2*U3
00305      &-16.D0*X2*F5*V3-32.D0*X2*F3*V5-16.D0*Y3*F5*U3+16.D0*Y3*F6*U3
00306      &-20.D0*X3*F4*V3+16.D0*X3*F5*V3-120.D0*Y2*F5*U2+120.D0*Y2*F4*U2
00307      &+120.D0*X2*F5*V2-16.D0*Y2*F6*U5+16.D0*X2*F6*V5
00308       W2(IELEM) = (-11.D0*Y2*F3*U1-16.D0*Y2*F4*U3-20.D0*X2*F3*V6-
00309      &              16.D0*X3*F6*V3+20.D0*Y2*F3*U6-12.D0*X3*F2*V6+
00310      &              24.D0*Y3*F5*U2+16.D0*X2*F4*V1+16.D0*Y2*F6*U4-
00311      &              16.D0*Y3*F5*U4-32.D0*Y3*F5*U5-32.D0*X3*F6*V5+
00312      &              20.D0*X2*F6*V3-9.D0*Y3*F2*U1+16.D0*X3*F5*V4+
00313      &              ANS1) * XSU2520
00314 !
00315       ANS1 = -48.D0*Y2*F3*U5-32.D0*X2*F6*V4-16.D0*Y2*F4*U6-
00316      &        16.D0*X3*F6*V4-24.D0*Y2*F5*U3+16.D0*Y3*F4*U5+
00317      &        16.D0*X2*F4*V6-12.D0*Y2*F3*U4-16.D0*X3*F4*V5+
00318      &        48.D0*X2*F4*V4+4.D0*Y2*F4*U1-4.D0*Y2*F5*U1+20.D0*Y3*F4*U2+
00319      &        4.D0*X2*F5*V1+12.D0*X2*F3*V4+9.D0*X3*F2*V2+16.D0*Y3*F6*U4+
00320      &        78.D0*X2*F3*V3+16.D0*Y3*F6*U2+32.D0*X2*F4*V5-
00321      &        48.D0*Y3*F6*U6+48.D0*Y2*F5*U4-20.D0*Y3*F2*U4+
00322      &        16.D0*Y2*F5*U6+18.D0*X3*F2*V3+16.D0*Y3*F6*U1-
00323      &        16.D0*X2*F5*V6-16.D0*Y3*F4*U6-48.D0*Y3*F6*U5-
00324      &        24.D0*X2*F4*V3-48.D0*X3*F5*V5-11.D0*X3*F2*V1-
00325      &        16.D0*Y3*F2*U6+96.D0*Y2*F6*U3-48.D0*Y2*F4*U4+
00326      &        9.D0*Y2*F3*U2-32.D0*Y3*F2*U5-16.D0*X3*F6*V2-
00327      &        48.D0*X2*F5*V4-9.D0*X2*F3*V2+20.D0*X3*F2*V4-
00328      &        20.D0*X3*F4*V2-78.D0*Y2*F3*U3-9.D0*Y3*F2*U2-
00329      &        16.D0*X3*F6*V1+48.D0*Y3*F5*U6-16.D0*Y3*F5*U1-
00330      &        32.D0*Y2*F4*U5+20.D0*X3*F4*V1+32.D0*Y2*F5*U5-
00331      &        32.D0*X2*F5*V5-48.D0*X3*F5*V6+32.D0*X3*F2*V5+
00332      &        16.D0*X3*F5*V2+16.D0*X3*F4*V6+16.D0*X2*F4*V2-
00333      &        9.D0*X2*F3*V1+16.D0*X3*F5*V1+48.D0*X3*F6*V6-
00334      &        18.D0*Y3*F2*U3+24.D0*X2*F5*V3+48.D0*X2*F3*V5
00335       W3(IELEM) =(120.D0*Y3*F5*U3-120.D0*Y3*F6*U3-120.D0*X3*F5*V3+
00336      &            16.D0*Y2*F5*U2-16.D0*Y2*F4*U2-16.D0*X2*F5*V2-
00337      &            20.D0*Y2*F6*U2+64.D0*Y2*F6*U5+20.D0*X2*F6*V2+
00338      &            80.D0*Y2*F6*U6-20.D0*Y3*F4*U1-80.D0*X2*F6*V6-
00339      &            64.D0*X2*F6*V5+9.D0*Y2*F3*U1+24.D0*Y2*F4*U3+
00340      &            48.D0*X2*F3*V6+120.D0*X3*F6*V3-48.D0*Y2*F3*U6+
00341      &            16.D0*X3*F2*V6-16.D0*Y3*F5*U2-4.D0*X2*F4*V1+
00342      &            32.D0*Y2*F6*U4-16.D0*Y3*F5*U4+48.D0*Y3*F5*U5+
00343      &            48.D0*X3*F6*V5-96.D0*X2*F6*V3+11.D0*Y3*F2*U1+
00344      &            16.D0*X3*F5*V4+ANS1) * XSU2520
00345 !
00346       ANS1 = 4.D0*Y2*F3*U5-64.D0*X2*F6*V4-32.D0*Y2*F4*U6-
00347      &       32.D0*X3*F6*V4-12.D0*Y2*F5*U3+16.D0*Y3*F4*U5+
00348      &       32.D0*X2*F4*V6-24.D0*Y2*F3*U4-16.D0*X3*F4*V5+
00349      &       96.D0*X2*F4*V4+8.D0*Y2*F4*U1-8.D0*Y2*F5*U1+
00350      &       20.D0*Y3*F4*U2+8.D0*X2*F5*V1+24.D0*X2*F3*V4+
00351      &       12.D0*X3*F2*V2+32.D0*Y3*F6*U4-3.D0*X2*F3*V3-
00352      &       4.D0*Y3*F6*U2+48.D0*X2*F4*V5+32.D0*Y3*F6*U6+
00353      &       96.D0*Y2*F5*U4-40.D0*Y3*F2*U4+32.D0*Y2*F5*U6-
00354      &       5.D0*X3*F2*V3-4.D0*Y3*F6*U1-32.D0*X2*F5*V6-16.D0*Y3*F4*U6+
00355      &       32.D0*Y3*F6*U5-12.D0*X2*F4*V3+32.D0*X3*F5*V5-
00356      &       8.D0*X3*F2*V1-4.D0*Y3*F2*U6-8.D0*Y2*F6*U3-96.D0*Y2*F4*U4-
00357      &       4.D0*Y2*F3*U2-20.D0*Y3*F2*U5+4.D0*X3*F6*V2-96.D0*X2*F5*V4+
00358      &       4.D0*X2*F3*V2+40.D0*X3*F2*V4-20.D0*X3*F4*V2+3.D0*Y2*F3*U3+
00359      &       16.D0*Y2*F6*U1-12.D0*Y3*F2*U2+4.D0*X3*F6*V1-32.D0*Y3*F5*U6+
00360      &       4.D0*Y3*F5*U1-48.D0*Y2*F4*U5+20.D0*X3*F4*V1+48.D0*Y2*F5*U5-
00361      &       48.D0*X2*F5*V5+32.D0*X3*F5*V6+20.D0*X3*F2*V5-4.D0*X3*F5*V2+
00362      &       16.D0*X3*F4*V6+12.D0*X2*F4*V2+4.D0*X2*F3*V1-4.D0*X3*F5*V1-
00363      &       16.D0*X2*F6*V1-32.D0*X3*F6*V6+5.D0*Y3*F2*U3+12.D0*X2*F5*V3-
00364      &       4.D0*X2*F3*V5+4.D0*Y3*F5*U3-4.D0*Y3*F6*U3-4.D0*X3*F5*V3+
00365      &       12.D0*Y2*F5*U2-12.D0*Y2*F4*U2-12.D0*X2*F5*V2-4.D0*Y2*F6*U2
00366       W4(IELEM) = (4.D0*X2*F6*V2+16.D0*Y2*F6*U6-20.D0*Y3*F4*U1-
00367      &            16.D0*X2*F6*V6-4.D0*Y2*F3*U1+12.D0*Y2*F4*U3-
00368      &            4.D0*X2*F3*V6+4.D0*X3*F6*V3+4.D0*Y2*F3*U6+
00369      &            4.D0*X3*F2*V6+4.D0*Y3*F5*U2-8.D0*X2*F4*V1+
00370      &            64.D0*Y2*F6*U4-32.D0*Y3*F5*U4-32.D0*Y3*F5*U5-
00371      &            32.D0*X3*F6*V5+8.D0*X2*F6*V3+8.D0*Y3*F2*U1+
00372      &            32.D0*X3*F5*V4+ ANS1) * (-XSU630)
00373 !
00374       ANS1 = -40.D0*Y2*F3*U5+32.D0*Y2*F4*U6+32.D0*X3*F6*V4+
00375      &        8.D0*Y2*F5*U3-64.D0*Y3*F4*U5-32.D0*X2*F4*V6-4.D0*Y2*F3*U4+
00376      &        64.D0*X3*F4*V5-48.D0*X2*F4*V4-12.D0*Y2*F4*U1+
00377      &        12.D0*Y2*F5*U1-16.D0*Y3*F4*U4-16.D0*Y3*F4*U2-
00378      &        12.D0*X2*F5*V1+4.D0*X2*F3*V4-12.D0*X3*F2*V2+
00379      &        16.D0*X3*F4*V4-32.D0*Y3*F6*U4+12.D0*X2*F3*V3+
00380      &        8.D0*Y3*F6*U2-96.D0*X2*F4*V5-48.D0*Y3*F6*U6-
00381      &        48.D0*Y2*F5*U4+20.D0*Y3*F2*U4-32.D0*Y2*F5*U6+
00382      &        8.D0*X3*F2*V3+12.D0*Y3*F6*U1+32.D0*X2*F5*V6-
00383      &        96.D0*Y3*F6*U5+8.D0*X2*F4*V3-96.D0*X3*F5*V5+
00384      &        5.D0*X3*F2*V1+4.D0*Y3*F2*U6+16.D0*Y2*F6*U3+48.D0*Y2*F4*U4+
00385      &        4.D0*Y3*F4*U3+8.D0*Y2*F3*U2+40.D0*Y3*F2*U5-
00386      &        8.D0*X3*F6*V2+48.D0*X2*F5*V4-8.D0*X2*F3*V2-
00387      &        20.D0*X3*F2*V4+16.D0*X3*F4*V2-12.D0*Y2*F3*U3-
00388      &        8.D0*Y2*F6*U1+12.D0*Y3*F2*U2-12.D0*X3*F6*V1+
00389      &        48.D0*Y3*F5*U6-12.D0*Y3*F5*U1+96.D0*Y2*F4*U5-
00390      &        8.D0*X3*F4*V1-96.D0*Y2*F5*U5+96.D0*X2*F5*V5-
00391      &        48.D0*X3*F5*V6-40.D0*X3*F2*V5+8.D0*X3*F5*V2-
00392      &        12.D0*X2*F4*V2-5.D0*X2*F3*V1+12.D0*X3*F5*V1+
00393      &        8.D0*X2*F6*V1+48.D0*X3*F6*V6-8.D0*Y3*F2*U3-8.D0*X2*F5*V3
00394       W5(IELEM) = (40.D0*X2*F3*V5+12.D0*Y3*F5*U3-12.D0*Y3*F6*U3-
00395      &            4.D0*X3*F4*V3-12.D0*X3*F5*V3-12.D0*Y2*F5*U2+
00396      &            12.D0*Y2*F4*U2+12.D0*X2*F5*V2-4.D0*Y2*F6*U2+
00397      &            64.D0*Y2*F6*U5+4.D0*X2*F6*V2+16.D0*Y2*F6*U6+
00398      &            8.D0*Y3*F4*U1-16.D0*X2*F6*V6-64.D0*X2*F6*V5+
00399      &            5.D0*Y2*F3*U1-8.D0*Y2*F4*U3+20.D0*X2*F3*V6+
00400      &            12.D0*X3*F6*V3-20.D0*Y2*F3*U6-4.D0*X3*F2*V6-
00401      &            8.D0*Y3*F5*U2+12.D0*X2*F4*V1+32.D0*Y3*F5*U4+
00402      &            96.D0*Y3*F5*U5+96.D0*X3*F6*V5-16.D0*X2*F6*V3-
00403      &            5.D0*Y3*F2*U1-32.D0*X3*F5*V4+ ANS1) * XSU630
00404 !
00405       ANS1 = 20.D0*Y2*F3*U5-16.D0*X2*F6*V4-32.D0*Y2*F4*U6-
00406      &       32.D0*X3*F6*V4-4.D0*Y2*F5*U3+32.D0*X2*F4*V6+4.D0*Y2*F3*U4+
00407      &       32.D0*X2*F4*V4+4.D0*Y2*F4*U1-4.D0*Y2*F5*U1-16.D0*Y3*F4*U4+
00408      &       8.D0*Y3*F4*U2+4.D0*X2*F5*V1-4.D0*X2*F3*V4+3.D0*X3*F2*V2+
00409      &       16.D0*X3*F4*V4+32.D0*Y3*F6*U4-12.D0*X2*F3*V3-
00410      &       12.D0*Y3*F6*U2+32.D0*X2*F4*V5+96.D0*Y3*F6*U6+
00411      &       32.D0*Y2*F5*U4-4.D0*Y3*F2*U4+32.D0*Y2*F5*U6-
00412      &       4.D0*X3*F2*V3-8.D0*Y3*F6*U1-32.D0*X2*F5*V6-64.D0*Y3*F4*U6+
00413      &       48.D0*Y3*F6*U5-4.D0*X2*F4*V3+48.D0*X3*F5*V5-4.D0*X3*F2*V1+
00414      &       24.D0*Y3*F2*U6-20.D0*Y2*F6*U3-32.D0*Y2*F4*U4+4.D0*Y3*F4*U3-
00415      &       5.D0*Y2*F3*U2-4.D0*Y3*F2*U5+12.D0*X3*F6*V2-32.D0*X2*F5*V4+
00416      &       5.D0*X2*F3*V2+4.D0*X3*F2*V4-8.D0*X3*F4*V2+12.D0*Y2*F3*U3+
00417      &       20.D0*Y2*F6*U1-3.D0*Y3*F2*U2+8.D0*X3*F6*V1-96.D0*Y3*F5*U6+
00418      &       8.D0*Y3*F5*U1-32.D0*Y2*F4*U5+16.D0*X3*F4*V1+32.D0*Y2*F5*U5-
00419      &       32.D0*X2*F5*V5+96.D0*X3*F5*V6+4.D0*X3*F2*V5-12.D0*X3*F5*V2+
00420      &       64.D0*X3*F4*V6-4.D0*X2*F4*V2+8.D0*X2*F3*V1-8.D0*X3*F5*V1-
00421      &       20.D0*X2*F6*V1-96.D0*X3*F6*V6+4.D0*Y3*F2*U3+4.D0*X2*F5*V3-
00422      &       20.D0*X2*F3*V5-12.D0*Y3*F5*U3+12.D0*Y3*F6*U3-4.D0*X3*F4*V3+
00423      &       12.D0*X3*F5*V3-4.D0*Y2*F5*U2+4.D0*Y2*F4*U2+4.D0*X2*F5*V2-
00424      &       16.D0*Y2*F6*U5-16.D0*Y3*F4*U1+16.D0*X2*F6*V5-8.D0*Y2*F3*U1
00425       W6(IELEM) = (4.D0*Y2*F4*U3-40.D0*X2*F3*V6-12.D0*X3*F6*V3+
00426      &            40.D0*Y2*F3*U6-24.D0*X3*F2*V6+12.D0*Y3*F5*U2-
00427      &            4.D0*X2*F4*V1+16.D0*Y2*F6*U4-32.D0*Y3*F5*U4-
00428      &            48.D0*Y3*F5*U5-48.D0*X3*F6*V5+20.D0*X2*F6*V3+
00429      &            4.D0*Y3*F2*U1+32.D0*X3*F5*V4+ANS1) * (-XSU630)
00430 !
00431       ENDDO ! IELEM
00432 !
00433       ENDIF
00434 !
00435 !     FUNCTION F IS P2 AND VECTOR U LINEAR
00436 !
00437       ELSEIF(IELMF.EQ.13.AND.IELMU.EQ.11.AND.IELMV.EQ.11) THEN
00438 !
00439       IF(FORMUL(14:16).EQ.'PSI') THEN
00440 !
00441 !     PSI SCHEME P1 AND LINEAR INTERPOLATION
00442 !
00443       DO IELEM = 1 , NELEM
00444 !
00445         X2 = XEL(IELEM+NELMAX)
00446         X3 = XEL(IELEM+2*NELMAX)
00447         Y2 = YEL(IELEM+NELMAX)
00448         Y3 = YEL(IELEM+2*NELMAX)
00449 !
00450         F1 = F(IKLE1(IELEM))
00451         F2 = F(IKLE2(IELEM))
00452         F3 = F(IKLE3(IELEM))
00453 !
00454         U1 = U(IKLE1(IELEM))
00455         U2 = U(IKLE2(IELEM))
00456         U3 = U(IKLE3(IELEM))
00457         V1 = V(IKLE1(IELEM))
00458         V2 = V(IKLE2(IELEM))
00459         V3 = V(IKLE3(IELEM))
00460 !
00461         USUR2 = (U1+U2+U3)*SUR6
00462         VSUR2 = (V1+V2+V3)*SUR6
00463 !
00464         K1 = USUR2 * (Y2-Y3) - VSUR2 * (X2-X3)
00465         K2 = USUR2 * (Y3   ) - VSUR2 * (X3   )
00466         K3 = USUR2 * (  -Y2) - VSUR2 * (  -X2)
00467 !
00468         L12 = MAX(  MIN(K1,-K2) , 0.D0 )
00469         L13 = MAX(  MIN(K1,-K3) , 0.D0 )
00470         L21 = MAX(  MIN(K2,-K1) , 0.D0 )
00471         L23 = MAX(  MIN(K2,-K3) , 0.D0 )
00472         L31 = MAX(  MIN(K3,-K1) , 0.D0 )
00473         L32 = MAX(  MIN(K3,-K2) , 0.D0 )
00474 !
00475         BETAN1 = L12*(F1-F2) + L13*(F1-F3)
00476         BETAN2 = L21*(F2-F1) + L23*(F2-F3)
00477         BETAN3 = L31*(F3-F1) + L32*(F3-F2)
00478 !
00479         PHIT = BETAN1 + BETAN2 + BETAN3
00480 !
00481         IF(PHIT.GT.0.D0) THEN
00482           W1(IELEM) =   XMUL * MAX( MIN( BETAN1, PHIT),0.D0 )
00483           W2(IELEM) =   XMUL * MAX( MIN( BETAN2, PHIT),0.D0 )
00484           W3(IELEM) =   XMUL * MAX( MIN( BETAN3, PHIT),0.D0 )
00485         ELSE
00486           W1(IELEM) = - XMUL * MAX( MIN(-BETAN1,-PHIT),0.D0 )
00487           W2(IELEM) = - XMUL * MAX( MIN(-BETAN2,-PHIT),0.D0 )
00488           W3(IELEM) = - XMUL * MAX( MIN(-BETAN3,-PHIT),0.D0 )
00489         ENDIF
00490         W4(IELEM) =   (W1(IELEM)+ W2(IELEM))/2.D0
00491         W5(IELEM) =   (W2(IELEM)+ W3(IELEM))/2.D0
00492         W6(IELEM) =   (W3(IELEM)+ W1(IELEM))/2.D0
00493 !
00494       ENDDO ! IELEM
00495 !
00496       ELSE
00497 !
00498 !     CLASSICAL COMPUTATION
00499 !
00500       DO IELEM = 1 , NELEM
00501 !
00502         X2 = XEL(IELEM+NELMAX)
00503         X3 = XEL(IELEM+2*NELMAX)
00504         Y2 = YEL(IELEM+NELMAX)
00505         Y3 = YEL(IELEM+2*NELMAX)
00506 !
00507         U1 = U(IKLE1(IELEM))
00508         U2 = U(IKLE2(IELEM))
00509         U3 = U(IKLE3(IELEM))
00510         V1 = V(IKLE1(IELEM))
00511         V2 = V(IKLE2(IELEM))
00512         V3 = V(IKLE3(IELEM))
00513 !
00514         F1 = F(IKLE1(IELEM))
00515         F2 = F(IKLE2(IELEM)) - F1
00516         F3 = F(IKLE3(IELEM)) - F1
00517         F4 = F(IKLE4(IELEM)) - F1
00518         F5 = F(IKLE5(IELEM)) - F1
00519         F6 = F(IKLE6(IELEM)) - F1
00520 !
00521       W1(IELEM) = (-4.D0*X3*F6*V2-4.D0*Y3*F5*U2-4.D0*Y2*F6*U2-
00522      &             8.D0*Y2*F4*U2-4.D0*X2*F5*V3-4.D0*Y2*F4*U3+
00523      &             8.D0*Y3*F6*U3-X2*F3*V2+4.D0*X3*F5*V2+4.D0*Y2*F5*U3+
00524      &             4.D0*Y3*F6*U2+8.D0*X3*F5*V3+4.D0*X2*F4*V3-
00525      &             6.D0*Y3*F2*U1+24.D0*X2*F6*V1+Y2*F3*U2+
00526      &             6.D0*Y2*F3*U1+8.D0*X2*F4*V2-8.D0*X2*F5*V2+
00527      &             8.D0*Y3*F4*U2-24.D0*X3*F4*V1+8.D0*Y2*F5*U2-
00528      &             5.D0*Y3*F2*U2-8.D0*X3*F4*V2-24.D0*Y2*F6*U1+
00529      &             6.D0*X3*F2*V1-6.D0*X2*F3*V1-Y3*F2*U3+5.D0*Y2*F3*U3-
00530      &             8.D0*Y2*F6*U3+8.D0*X2*F6*V3+4.D0*X2*F6*V2-
00531      &             4.D0*X3*F4*V3-8.D0*X3*F6*V3-5.D0*X2*F3*V3+
00532      &             24.D0*Y3*F4*U1+4.D0*Y3*F4*U3+5.D0*X3*F2*V2-
00533      &             8.D0*Y3*F5*U3+X3*F2*V3) * XSU360
00534 !
00535       W2(IELEM)= (-24.D0*Y2*F4*U2-8.D0*Y3*F6*U3+6.D0*X2*F3*V2-
00536      &            4.D0*Y3*F6*U1-8.D0*X3*F5*V3+4.D0*X3*F6*V1-
00537      &            3.D0*Y3*F2*U1+4.D0*X2*F6*V1-6.D0*Y2*F3*U2-Y2*F3*U1+
00538      &            4.D0*Y3*F5*U1+24.D0*X2*F4*V2-24.D0*X2*F5*V2+
00539      &            24.D0*Y3*F4*U2-8.D0*X3*F4*V1+24.D0*Y2*F5*U2-
00540      &            18.D0*Y3*F2*U2-24.D0*X3*F4*V2-4.D0*Y2*F6*U1+
00541      &            3.D0*X3*F2*V1+X2*F3*V1-3.D0*Y3*F2*U3-5.D0*Y2*F3*U3-
00542      &            4.D0*X3*F5*V1+4.D0*Y2*F6*U3-4.D0*X2*F6*V3-
00543      &            4.D0*X3*F4*V3+8.D0*X3*F6*V3+5.D0*X2*F3*V3+
00544      &            8.D0*Y3*F4*U1+4.D0*Y3*F4*U3+18.D0*X3*F2*V2+
00545      &            8.D0*Y3*F5*U3+3.D0*X3*F2*V3) * (-XSU360)
00546 !
00547       W3(IELEM)= (4.D0*X2*F5*V1-4.D0*Y2*F6*U2-4.D0*Y2*F5*U1+
00548      &            8.D0*Y2*F4*U2+24.D0*Y3*F6*U3-3.D0*X2*F3*V2+
00549      &            24.D0*X3*F5*V3+Y3*F2*U1+8.D0*X2*F6*V1+4.D0*Y2*F4*U1+
00550      &            3.D0*Y2*F3*U2+3.D0*Y2*F3*U1-4.D0*X2*F4*V1-
00551      &            8.D0*X2*F4*V2+8.D0*X2*F5*V2-4.D0*Y3*F4*U2-
00552      &            4.D0*X3*F4*V1-8.D0*Y2*F5*U2+5.D0*Y3*F2*U2+
00553      &            4.D0*X3*F4*V2-8.D0*Y2*F6*U1-X3*F2*V1-3.D0*X2*F3*V1+
00554      &            6.D0*Y3*F2*U3+18.D0*Y2*F3*U3-24.D0*Y2*F6*U3+
00555      &            24.D0*X2*F6*V3+4.D0*X2*F6*V2-24.D0*X3*F6*V3-
00556      &            18.D0*X2*F3*V3+4.D0*Y3*F4*U1-5.D0*X3*F2*V2-
00557      &            24.D0*Y3*F5*U3-6.D0*X3*F2*V3)*(-XSU360)
00558 !
00559       W4(IELEM) = (4.D0*X3*F6*V2+8.D0*X2*F5*V1+4.D0*Y3*F5*U2-
00560      &             4.D0*Y2*F6*U2-8.D0*Y2*F5*U1+12.D0*Y2*F4*U2+
00561      &             4.D0*X2*F5*V3+4.D0*Y2*F4*U3-4.D0*Y3*F6*U3-
00562      &             2.D0*X2*F3*V2-4.D0*X3*F5*V2-4.D0*Y3*F6*U1-
00563      &             4.D0*Y2*F5*U3-4.D0*Y3*F6*U2-4.D0*X3*F5*V3+
00564      &             4.D0*X3*F6*V1-4.D0*X2*F4*V3+2.D0*Y3*F2*U1+
00565      &             8.D0*X2*F6*V1+8.D0*Y2*F4*U1+2.D0*Y2*F3*U2+
00566      &             2.D0*Y2*F3*U1+4.D0*Y3*F5*U1-8.D0*X2*F4*V1-
00567      &             12.D0*X2*F4*V2+12.D0*X2*F5*V2-4.D0*Y3*F4*U2-
00568      &             4.D0*X3*F4*V1-12.D0*Y2*F5*U2+6.D0*Y3*F2*U2+
00569      &             4.D0*X3*F4*V2-8.D0*Y2*F6*U1-2.D0*X3*F2*V1-
00570      &             2.D0*X2*F3*V1+Y3*F2*U3-Y2*F3*U3-4.D0*X3*F5*V1+
00571      &             4.D0*X2*F6*V2+4.D0*X3*F6*V3+X2*F3*V3+4.D0*Y3*F4*U1-
00572      &             6.D0*X3*F2*V2+4.D0*Y3*F5*U3-X3*F2*V3)*XSU90
00573 !
00574       W5(IELEM) = (8.D0*X3*F6*V2+4.D0*X2*F5*V1+8.D0*Y3*F5*U2+
00575      &             4.D0*Y2*F6*U2-4.D0*Y2*F5*U1+12.D0*Y2*F4*U2+
00576      &             8.D0*X2*F5*V3+8.D0*Y2*F4*U3-12.D0*Y3*F6*U3+
00577      &             2.D0*X2*F3*V2-8.D0*X3*F5*V2-4.D0*Y3*F6*U1-
00578      &             8.D0*Y2*F5*U3-8.D0*Y3*F6*U2-12.D0*X3*F5*V3+
00579      &             4.D0*X3*F6*V1-8.D0*X2*F4*V3+Y3*F2*U1+4.D0*Y2*F4*U1-
00580      &             2.D0*Y2*F3*U2-Y2*F3*U1+4.D0*Y3*F5*U1-4.D0*X2*F4*V1-
00581      &             12.D0*X2*F4*V2+12.D0*X2*F5*V2-8.D0*Y3*F4*U2-
00582      &             12.D0*Y2*F5*U2+6.D0*Y3*F2*U2+8.D0*X3*F4*V2-X3*F2*V1+
00583      &             X2*F3*V1+2.D0*Y3*F2*U3-6.D0*Y2*F3*U3-4.D0*X3*F5*V1+
00584      &             8.D0*Y2*F6*U3-8.D0*X2*F6*V3-4.D0*X2*F6*V2+
00585      &             4.D0*X3*F4*V3+12.D0*X3*F6*V3+6.D0*X2*F3*V3-
00586      &             4.D0*Y3*F4*U3-6.D0*X3*F2*V2+12.D0*Y3*F5*U3-
00587      &             2.D0*X3*F2*V3) * XSU90
00588       W6(IELEM) = (4.D0*X3*F6*V2+4.D0*X2*F5*V1+4.D0*Y3*F5*U2-
00589      &             4.D0*Y2*F5*U1+4.D0*Y2*F4*U2+4.D0*X2*F5*V3+
00590      &             4.D0*Y2*F4*U3-12.D0*Y3*F6*U3+X2*F3*V2-
00591      &             4.D0*X3*F5*V2-8.D0*Y3*F6*U1-4.D0*Y2*F5*U3-
00592      &             4.D0*Y3*F6*U2-12.D0*X3*F5*V3+8.D0*X3*F6*V1-
00593      &             4.D0*X2*F4*V3-2.D0*Y3*F2*U1+4.D0*X2*F6*V1+
00594      &             4.D0*Y2*F4*U1-Y2*F3*U2-2.D0*Y2*F3*U1+8.D0*Y3*F5*U1-
00595      &             4.D0*X2*F4*V1-4.D0*X2*F4*V2+4.D0*X2*F5*V2-
00596      &             8.D0*X3*F4*V1-4.D0*Y2*F5*U2+Y3*F2*U2-
00597      &             4.D0*Y2*F6*U1+2.D0*X3*F2*V1+2.D0*X2*F3*V1-
00598      &             2.D0*Y3*F2*U3-6.D0*Y2*F3*U3-8.D0*X3*F5*V1+
00599      &             4.D0*Y2*F6*U3-4.D0*X2*F6*V3-4.D0*X3*F4*V3+
00600      &             12.D0*X3*F6*V3+6.D0*X2*F3*V3+8.D0*Y3*F4*U1+
00601      &             4.D0*Y3*F4*U3-X3*F2*V2+12.D0*Y3*F5*U3+2.D0*X3*F2*V3)
00602      &             * XSU90
00603 !
00604       ENDDO
00605 !
00606       ENDIF
00607 !
00608 !-----------------------------------------------------------------------
00609 !
00610       ELSE
00611 !
00612 !-----------------------------------------------------------------------
00613 !
00614         IF (LNG.EQ.1) WRITE(LU,100) IELMF,SF%NAME
00615         IF (LNG.EQ.1) WRITE(LU,200) IELMU,SU%NAME
00616         IF (LNG.EQ.1) WRITE(LU,300)
00617         IF (LNG.EQ.2) WRITE(LU,101) IELMF,SF%NAME
00618         IF (LNG.EQ.1) WRITE(LU,201) IELMU,SU%NAME
00619         IF (LNG.EQ.1) WRITE(LU,301)
00620 100     FORMAT(1X,'VC08CC (BIEF) :',/,
00621      &         1X,'DISCRETISATION DE F : ',1I6,
00622      &         1X,'NOM REEL : ',A6)
00623 200     FORMAT(1X,'DISCRETISATION DE U : ',1I6,
00624      &         1X,'NOM REEL : ',A6)
00625 300     FORMAT(1X,'CAS NON PREVU')
00626 101     FORMAT(1X,'VC08CC (BIEF) :',/,
00627      &         1X,'DISCRETIZATION OF F:',1I6,
00628      &         1X,'REAL NAME: ',A6)
00629 201     FORMAT(1X,'DISCRETIZATION OF U:',1I6,
00630      &         1X,'REAL NAME: ',A6)
00631 301     FORMAT(1X,'CASE NOT IMPLEMENTED')
00632         CALL PLANTE(1)
00633         STOP
00634 !
00635       ENDIF
00636 !
00637 !-----------------------------------------------------------------------
00638 !
00639       RETURN
00640       END

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