vc11tt.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\vc11tt.f
00002 !
00084                      SUBROUTINE VC11TT
00085 !                    *****************
00086 !
00087      &( XMUL,SF,SG,F,G,X,Y,Z,IKLE1,IKLE2,IKLE3,IKLE4,NELEM,NELMAX,
00088      &  W1,W2,W3,W4,ICOORD )
00089 !
00090 !***********************************************************************
00091 ! BIEF   V6P1                                  21/08/2010
00092 !***********************************************************************
00093 !
00094 !
00095 !
00096 !
00097 !
00098 !
00099 !
00100 !
00101 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00102 !| F              |-->| FUNCTION USED IN THE VECTOR FORMULA
00103 !| G              |-->| FUNCTION USED IN THE VECTOR FORMULA
00104 !| ICOORD         |-->| 1: DERIVATIVE ALONG X, 2: ALONG Y
00105 !| IKLE1          |-->| FIRST POINT OF TETRAHEDRA
00106 !| IKLE2          |-->| SECOND POINT OF TETRAHEDRA
00107 !| IKLE3          |-->| THIRD POINT OF TETRAHEDRA
00108 !| IKLE4          |-->| FOURTH POINT OF TETRAHEDRA
00109 !| NELEM          |-->| NUMBER OF ELEMENTS
00110 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00111 !| SF             |-->| BIEF_OBJ STRUCTURE OF F
00112 !| SG             |-->| BIEF_OBJ STRUCTURE OF G
00113 !| SURFAC         |-->| AREA OF TRIANGLES
00114 !| W1             |<--| RESULT IN NON ASSEMBLED FORM
00115 !| W2             |<--| RESULT IN NON ASSEMBLED FORM
00116 !| W3             |<--| RESULT IN NON ASSEMBLED FORM
00117 !| W4             |<--| RESULT IN NON ASSEMBLED FORM
00118 !| XEL            |-->| ABSCISSAE OF POINTS IN THE MESH, PER ELEMENT
00119 !| XMUL           |-->| MULTIPLICATION COEFFICIENT
00120 !| YEL            |-->| ORDINATES OF POINTS IN THE MESH, PER ELEMENT
00121 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00122 !
00123       USE BIEF
00124 !
00125       IMPLICIT NONE
00126       INTEGER LNG,LU
00127       COMMON/INFO/LNG,LU
00128 !
00129 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00130 !
00131       INTEGER, INTENT(IN) :: NELEM,NELMAX,ICOORD
00132       INTEGER, INTENT(IN) :: IKLE1(NELMAX),IKLE2(NELMAX)
00133       INTEGER, INTENT(IN) :: IKLE3(NELMAX),IKLE4(NELMAX)
00134 !
00135       DOUBLE PRECISION, INTENT(IN) :: X(*),Y(*),Z(*),XMUL
00136       DOUBLE PRECISION, INTENT(INOUT) :: W1(NELMAX),W2(NELMAX)
00137       DOUBLE PRECISION, INTENT(INOUT) :: W3(NELMAX),W4(NELMAX)
00138 !
00139 !     STRUCTURES OF F, G, H, U, V, W AND REAL DATA
00140 !
00141       TYPE(BIEF_OBJ), INTENT(IN) :: SF,SG
00142       DOUBLE PRECISION, INTENT(IN) :: F(*),G(*)
00143 !
00144 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00145 !
00146 ! LOCAL VARIABLES
00147 !
00148       INTEGER IELEM,IELMF,IELMG
00149       DOUBLE PRECISION F1,F2,F3,F4
00150       DOUBLE PRECISION G1,G2,G3,G4,X2,X3,X4,Y2,Y3,Y4,Z2,Z3,Z4
00151       INTEGER I1,I2,I3,I4
00152 !
00153       DOUBLE PRECISION XSUR120,F2MF1,F3MF1,F4MF1,G2MG1,G3MG1,G4MG1
00154 !
00155 !-----------------------------------------------------------------------
00156 ! INITIALISES
00157 !
00158       XSUR120 = XMUL/120.D0
00159 !
00160       IELMF = SF%ELM
00161       IELMG = SG%ELM
00162 !
00163 !-----------------------------------------------------------------------
00164 !     F AND G ARE LINEAR
00165 !
00166       IF ((IELMF.EQ.31.AND.((IELMG.EQ.31).OR.(IELMG.EQ.30))).OR.
00167      &    (IELMF.EQ.51.AND.IELMG.EQ.51)     ) THEN
00168 !
00169         IF (ICOORD.EQ.1) THEN
00170 !
00171 !-----------------------------------------------------------------------
00172 !  DERIVATIVE WRT X
00173 !
00174           DO  IELEM = 1 , NELEM
00175 !
00176             I1 = IKLE1(IELEM)
00177             I2 = IKLE2(IELEM)
00178             I3 = IKLE3(IELEM)
00179             I4 = IKLE4(IELEM)
00180 !
00181             F1 = F(I1)
00182             F2 = F(I2)
00183             F3 = F(I3)
00184             F4 = F(I4)
00185 !
00186             IF (IELMG.EQ.31) THEN
00187               G1 = G(I1)
00188               G2 = G(I2)
00189               G3 = G(I3)
00190               G4 = G(I4)
00191             ELSE
00192               G1 = G(IELEM)
00193               G2 = G1
00194               G3 = G1
00195               G4 = G1
00196             ENDIF
00197 
00198 !
00199             F2MF1 = F2-F1
00200             F3MF1 = F3-F1
00201             F4MF1 = F4-F1
00202             G2MG1 = G2-G1
00203             G3MG1 = G3-G1
00204             G4MG1 = G4-G1
00205 !
00206 !  REAL COORDINATES OF THE POINTS OF THE ELEMENT (ORIGIN IN 1)
00207 !
00208             Y2  =  Y(I2) - Y(I1)
00209             Y3  =  Y(I3) - Y(I1)
00210             Y4  =  Y(I4) - Y(I1)
00211             Z2  =  Z(I2) - Z(I1)
00212             Z3  =  Z(I3) - Z(I1)
00213             Z4  =  Z(I4) - Z(I1)
00214 !
00215             W1(IELEM) = (
00216      & (5*F2MF1*G1+F2MF1*G2MG1+F2MF1*G3MG1+F2MF1*G4MG1)*(Y3*Z4-Y4*Z3)
00217      &+(5*F3MF1*G1+F3MF1*G2MG1+F3MF1*G3MG1+F3MF1*G4MG1)*(Z2*Y4-Y2*Z4)
00218      &+(5*F4MF1*G1+F4MF1*G2MG1+F4MF1*G3MG1+F4MF1*G4MG1)*(Y2*Z3-Z2*Y3)
00219      &               ) * XSUR120
00220 !
00221             W2(IELEM) = (
00222      &-F4MF1*Z2*Y3*G4MG1+F4MF1*Y2*Z3*G4MG1+F3MF1*Z2*Y4*G4MG1
00223      &-F3MF1*Y2*Z4*G4MG1+F2MF1*Y3*Z4*G4MG1-F2MF1*Y4*Z3*G4MG1
00224      &+5*F2MF1*Y3*Z4*G1+2*F2MF1*Y3*Z4*G2MG1+F2MF1*Y3*Z4*G3MG1
00225      &-5*F2MF1*Y4*Z3*G1-2*F2MF1*Y4*Z3*G2MG1-F2MF1*Y4*Z3*G3MG1
00226      &-5*F3MF1*Y2*Z4*G1-2*F3MF1*Y2*Z4*G2MG1-F3MF1*Y2*Z4*G3MG1
00227      &+5*F3MF1*Z2*Y4*G1+2*F3MF1*Z2*Y4*G2MG1+F3MF1*Z2*Y4*G3MG1
00228      &+5*F4MF1*Y2*Z3*G1+2*F4MF1*Y2*Z3*G2MG1+F4MF1*Y2*Z3*G3MG1
00229      &-5*F4MF1*Z2*Y3*G1-2*F4MF1*Z2*Y3*G2MG1-F4MF1*Z2*Y3*G3MG1
00230      &               ) * XSUR120
00231             W3(IELEM) = (
00232      &-(-F2MF1*Y3*Z4+F2MF1*Y4*Z3+F3MF1*Y2*Z4
00233      &  -F3MF1*Z2*Y4-F4MF1*Y2*Z3+F4MF1*Z2*Y3)
00234      &               *(2*G3MG1+G2MG1+G4MG1+5*G1)
00235      &               ) * XSUR120
00236             W4(IELEM) = (
00237      &-2*F4MF1*Z2*Y3*G4MG1
00238      &+2*F4MF1*Y2*Z3*G4MG1
00239      &+2*F3MF1*Z2*Y4*G4MG1
00240      &-2*F3MF1*Y2*Z4*G4MG1
00241      &+2*F2MF1*Y3*Z4*G4MG1
00242      &-2*F2MF1*Y4*Z3*G4MG1
00243      &+5*F2MF1*Y3*Z4*G1
00244      &+F2MF1*Y3*Z4*G2MG1
00245      &+F2MF1*Y3*Z4*G3MG1-5*F2MF1*Y4*Z3*G1-F2MF1*Y4*Z3*G2MG1
00246      &-F2MF1*Y4*Z3*G3MG1-5*F3MF1*Y2*Z4*G1-F3MF1*Y2*Z4*G2MG1
00247      &-F3MF1*Y2*Z4*G3MG1+5*F3MF1*Z2*Y4*G1+F3MF1*Z2*Y4*G2MG1
00248      &+F3MF1*Z2*Y4*G3MG1+5*F4MF1*Y2*Z3*G1+F4MF1*Y2*Z3*G2MG1
00249      &+F4MF1*Y2*Z3*G3MG1-5*F4MF1*Z2*Y3*G1-F4MF1*Z2*Y3*G2MG1
00250      &-F4MF1*Z2*Y3*G3MG1
00251      &               ) * XSUR120
00252 !
00253           ENDDO
00254 !
00255         ELSE IF (ICOORD.EQ.2) THEN
00256 !
00257 !-----------------------------------------------------------------------
00258 !  DERIVATIVE WRT Y
00259 !
00260           DO   IELEM = 1 , NELEM
00261 !
00262             I1 = IKLE1(IELEM)
00263             I2 = IKLE2(IELEM)
00264             I3 = IKLE3(IELEM)
00265             I4 = IKLE4(IELEM)
00266 !
00267             F1 = F(I1)
00268             F2 = F(I2)
00269             F3 = F(I3)
00270             F4 = F(I4)
00271 !
00272             IF (IELMG.EQ.31) THEN
00273               G1 = G(I1)
00274               G2 = G(I2)
00275               G3 = G(I3)
00276               G4 = G(I4)
00277             ELSE
00278               G1 = G(IELEM)
00279               G2 = G1
00280               G3 = G1
00281               G4 = G1
00282             ENDIF
00283 !
00284             F2MF1 = F2-F1
00285             F3MF1 = F3-F1
00286             F4MF1 = F4-F1
00287             G2MG1 = G2-G1
00288             G3MG1 = G3-G1
00289             G4MG1 = G4-G1
00290 !
00291 !  REAL COORDINATES OF THE POINTS OF THE ELEMENT (ORIGIN IN 1)
00292 !
00293             X2  =  X(I2) - X(I1)
00294             X3  =  X(I3) - X(I1)
00295             X4  =  X(I4) - X(I1)
00296             Z2  =  Z(I2) - Z(I1)
00297             Z3  =  Z(I3) - Z(I1)
00298             Z4  =  Z(I4) - Z(I1)
00299 !
00300             W1(IELEM) = (
00301      &-F2MF1*X3*Z4*G2MG1+F3MF1*X2*Z4*G3MG1+5*F3MF1*X2*Z4*G1
00302      &-F2MF1*X3*Z4*G3MG1-5*F2MF1*X3*Z4*G1
00303      &+F2MF1*X4*Z3*G2MG1+F2MF1*X4*Z3*G3MG1+5*F2MF1*X4*Z3*G1
00304      &+F3MF1*X2*Z4*G2MG1+F4MF1*Z2*X3*G2MG1+F4MF1*Z2*X3*G3MG1
00305      &+5*F4MF1*Z2*X3*G1-F4MF1*X2*Z3*G2MG1-F4MF1*X2*Z3*G3MG1
00306      &-5*F4MF1*X2*Z3*G1-F3MF1*Z2*X4*G2MG1-F3MF1*Z2*X4*G3MG1
00307      &-5*F3MF1*Z2*X4*G1+F2MF1*X4*Z3*G4MG1+F3MF1*X2*Z4*G4MG1
00308      &-F4MF1*X2*Z3*G4MG1-F3MF1*Z2*X4*G4MG1-F2MF1*X3*Z4*G4MG1
00309      &+F4MF1*Z2*X3*G4MG1 ) * XSUR120
00310             W2(IELEM) = (
00311      &         -2*F2MF1*X3*Z4*G2MG1+F3MF1*X2*Z4*G3MG1+5*F3MF1*X2*Z4*G1-F
00312      &2MF1*X3*Z4*G3MG1-5*F2MF1*X3*Z4*G1+2*F2MF1*X4*Z3*G2MG1+F2MF1*X4*Z3*
00313      &G3MG1+5*F2MF1*X4*Z3*G1+2*F3MF1*X2*Z4*G2MG1+2*F4MF1*Z2*X3*G2MG1+F4M
00314      &F1*Z2*X3*G3MG1+5*F4MF1*Z2*X3*G1-2*F4MF1*X2*Z3*G2MG1-F4MF1*X2*Z3*G3
00315      &MG1-5*F4MF1*X2*Z3*G1-2*F3MF1*Z2*X4*G2MG1-F3MF1*Z2*X4*G3MG1-5*F3MF1
00316      &*Z2*X4*G1+F2MF1*X4*Z3*G4MG1+F3MF1*X2*Z4*G4MG1-F4MF1*X2*Z3*G4MG1-F3
00317      &MF1*Z2*X4*G4MG1-F2MF1*X3*Z4*G4MG1+F4MF1*Z2*X3*G4MG1 ) * XSUR120
00318             W3(IELEM) = (
00319      &         -(F2MF1*X3*Z4-F2MF1*X4*Z3-F3MF1*X2*Z4+F3MF1*Z2*X4+F4MF1*X
00320      &2*Z3-F4MF1*Z2*X3)*(2*G3MG1+G2MG1+G4MG1+5*G1) ) * XSUR120
00321             W4(IELEM) = (
00322      &         -F2MF1*X3*Z4*G2MG1+F3MF1*X2*Z4*G3MG1+5*F3MF1*X2*Z4*G1-F2M
00323      &F1*X3*Z4*G3MG1-5*F2MF1*X3*Z4*G1+F2MF1*X4*Z3*G2MG1+F2MF1*X4*Z3*G3MG
00324      &1+5*F2MF1*X4*Z3*G1+F3MF1*X2*Z4*G2MG1+F4MF1*Z2*X3*G2MG1+F4MF1*Z2*X3
00325      &*G3MG1+5*F4MF1*Z2*X3*G1-F4MF1*X2*Z3*G2MG1-F4MF1*X2*Z3*G3MG1-5*F4MF
00326      &1*X2*Z3*G1-F3MF1*Z2*X4*G2MG1-F3MF1*Z2*X4*G3MG1-5*F3MF1*Z2*X4*G1+2*
00327      &F2MF1*X4*Z3*G4MG1+2*F3MF1*X2*Z4*G4MG1-2*F4MF1*X2*Z3*G4MG1-2*F3MF1*
00328      &Z2*X4*G4MG1-2*F2MF1*X3*Z4*G4MG1+2*F4MF1*Z2*X3*G4MG1 ) * XSUR120
00329 !
00330           ENDDO
00331 !
00332         ELSE IF (ICOORD.EQ.3) THEN
00333 !-----------------------------------------------------------------------
00334 !  DERIVATIVE WRT Z
00335 !
00336           DO   IELEM = 1 , NELEM
00337 !
00338             I1 = IKLE1(IELEM)
00339             I2 = IKLE2(IELEM)
00340             I3 = IKLE3(IELEM)
00341             I4 = IKLE4(IELEM)
00342 !
00343             F1 = F(I1)
00344             F2 = F(I2)
00345             F3 = F(I3)
00346             F4 = F(I4)
00347 !
00348             IF (IELMG.EQ.31) THEN
00349               G1 = G(I1)
00350               G2 = G(I2)
00351               G3 = G(I3)
00352               G4 = G(I4)
00353             ELSE
00354               G1 = G(IELEM)
00355               G2 = G1
00356               G3 = G1
00357               G4 = G1
00358             ENDIF
00359 !
00360             F2MF1 = F2-F1
00361             F3MF1 = F3-F1
00362             F4MF1 = F4-F1
00363             G2MG1 = G2-G1
00364             G3MG1 = G3-G1
00365             G4MG1 = G4-G1
00366 !
00367 !  REAL COORDINATES OF THE POINTS OF THE ELEMENT
00368 !
00369             X2  =  X(I2) - X(I1)
00370             X3  =  X(I3) - X(I1)
00371             X4  =  X(I4) - X(I1)
00372             Y2  =  Y(I2) - Y(I1)
00373             Y3  =  Y(I3) - Y(I1)
00374             Y4  =  Y(I4) - Y(I1)
00375 !
00376             W1(IELEM) = (
00377      &         5*F2MF1*X3*Y4*G1+F2MF1*X3*Y4*G2MG1+F2MF1*X3*Y4*G3MG1-5*F2
00378      &MF1*X4*Y3*G1-F2MF1*X4*Y3*G2MG1-F2MF1*X4*Y3*G3MG1-5*F3MF1*X2*Y4*G1-
00379      &F3MF1*X2*Y4*G2MG1-F3MF1*X2*Y4*G3MG1+5*F3MF1*Y2*X4*G1+F3MF1*Y2*X4*G
00380      &2MG1+F3MF1*Y2*X4*G3MG1+5*F4MF1*X2*Y3*G1+F4MF1*X2*Y3*G2MG1-5*F4MF1*
00381      &Y2*X3*G1-F4MF1*Y2*X3*G2MG1-F4MF1*Y2*X3*G3MG1+F4MF1*X2*Y3*G3MG1-F4M
00382      &F1*Y2*X3*G4MG1-F3MF1*X2*Y4*G4MG1+F4MF1*X2*Y3*G4MG1+F2MF1*X3*Y4*G4M
00383      &G1+F3MF1*Y2*X4*G4MG1-F2MF1*X4*Y3*G4MG1 ) * XSUR120
00384             W2(IELEM) = (
00385      &         5*F2MF1*X3*Y4*G1+2*F2MF1*X3*Y4*G2MG1+F2MF1*X3*Y4*G3MG1-5*
00386      &F2MF1*X4*Y3*G1-2*F2MF1*X4*Y3*G2MG1-F2MF1*X4*Y3*G3MG1-5*F3MF1*X2*Y4
00387      &*G1-2*F3MF1*X2*Y4*G2MG1-F3MF1*X2*Y4*G3MG1+5*F3MF1*Y2*X4*G1+2*F3MF1
00388      &*Y2*X4*G2MG1+F3MF1*Y2*X4*G3MG1+5*F4MF1*X2*Y3*G1+2*F4MF1*X2*Y3*G2MG
00389      &1-5*F4MF1*Y2*X3*G1-2*F4MF1*Y2*X3*G2MG1-F4MF1*Y2*X3*G3MG1+F4MF1*X2*
00390      &Y3*G3MG1-F4MF1*Y2*X3*G4MG1-F3MF1*X2*Y4*G4MG1+F4MF1*X2*Y3*G4MG1+F2M
00391      &F1*X3*Y4*G4MG1+F3MF1*Y2*X4*G4MG1-F2MF1*X4*Y3*G4MG1 ) * XSUR120
00392             W3(IELEM) = (
00393      &         -(-F2MF1*X3*Y4+F2MF1*X4*Y3+F3MF1*X2*Y4-F3MF1*Y2*X4-F4MF1*
00394      &X2*Y3+F4MF1*Y2*X3)*(2*G3MG1+G2MG1+G4MG1+5*G1) ) * XSUR120
00395             W4(IELEM) = (
00396      &         5*F2MF1*X3*Y4*G1+F2MF1*X3*Y4*G2MG1+F2MF1*X3*Y4*G3MG1-5*F2
00397      &MF1*X4*Y3*G1-F2MF1*X4*Y3*G2MG1-F2MF1*X4*Y3*G3MG1-5*F3MF1*X2*Y4*G1-
00398      &F3MF1*X2*Y4*G2MG1-F3MF1*X2*Y4*G3MG1+5*F3MF1*Y2*X4*G1+F3MF1*Y2*X4*G
00399      &2MG1+F3MF1*Y2*X4*G3MG1+5*F4MF1*X2*Y3*G1+F4MF1*X2*Y3*G2MG1-5*F4MF1*
00400      &Y2*X3*G1-F4MF1*Y2*X3*G2MG1-F4MF1*Y2*X3*G3MG1+F4MF1*X2*Y3*G3MG1-2*F
00401      &4MF1*Y2*X3*G4MG1-2*F3MF1*X2*Y4*G4MG1+2*F4MF1*X2*Y3*G4MG1+2*F2MF1*X
00402      &3*Y4*G4MG1+2*F3MF1*Y2*X4*G4MG1-2*F2MF1*X4*Y3*G4MG1 ) * XSUR120
00403 !
00404           ENDDO
00405 !
00406         ELSE
00407 !
00408 !-----------------------------------------------------------------------
00409 !
00410           IF (LNG.EQ.1) WRITE(LU,200) ICOORD
00411           IF (LNG.EQ.2) WRITE(LU,201) ICOORD
00412  200      FORMAT(1X,'VC11TT (BIEF) : COMPOSANTE IMPOSSIBLE ',
00413      &         1I6,' VERIFIER ICOORD')
00414  201      FORMAT(1X,'VC11TT (BIEF) : IMPOSSIBLE COMPONENT ',
00415      &         1I6,' CHECK ICOORD')
00416           CALL PLANTE(1)
00417           STOP
00418 !
00419         ENDIF
00420 !
00421 !-----------------------------------------------------------------------
00422 ! ERROR
00423 !
00424       ELSE
00425 !
00426 !-----------------------------------------------------------------------
00427 !
00428         IF (LNG.EQ.1) WRITE(LU,1100) IELMF,SF%NAME
00429         IF (LNG.EQ.1) WRITE(LU,1200) IELMG,SG%NAME
00430         IF (LNG.EQ.1) WRITE(LU,1300)
00431         IF (LNG.EQ.2) WRITE(LU,1101) IELMF,SF%NAME
00432         IF (LNG.EQ.2) WRITE(LU,1201) IELMG,SG%NAME
00433         IF (LNG.EQ.2) WRITE(LU,1301)
00434         CALL PLANTE(1)
00435         STOP
00436  1100   FORMAT(1X,'VC11TT (BIEF) :',/,
00437      &         1X,'DISCRETISATION DE F : ',1I6,
00438      &         1X,'NOM REEL : ',A6)
00439  1200   FORMAT(1X,'DISCRETISATION DE G : ',1I6,
00440      &         1X,'NOM REEL : ',A6)
00441  1300   FORMAT(1X,'CAS NON PREVU')
00442  1101   FORMAT(1X,'VC11TT (BIEF) :',/,
00443      &         1X,'DISCRETIZATION OF F:',1I6,
00444      &         1X,'REAL NAME: ',A6)
00445  1201   FORMAT(1X,'DISCRETIZATION OF G:',1I6,
00446      &         1X,'REAL NAME: ',A6)
00447  1301   FORMAT(1X,'CASE NOT IMPLEMENTED')
00448 !
00449       ENDIF
00450 !
00451 !-----------------------------------------------------------------------
00452 !
00453       RETURN
00454       END

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