mt11bb.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mt11bb.f
00002 !
00090                      SUBROUTINE MT11BB
00091 !                    *****************
00092 !
00093      &(  A11 , A12 , A13 , A14 ,
00094      &   A21 , A22 , A23 , A24 ,
00095      &   A31 , A32 , A33 , A34 ,
00096      &   A41 , A42 , A43 , A44 ,
00097      &   XMUL,SF,F,XEL,YEL,IKLE1,IKLE2,IKLE3,IKLE4,
00098      &   NELEM,NELMAX,ICOORD)
00099 !
00100 !***********************************************************************
00101 ! BIEF   V6P1                                   21/08/2010
00102 !***********************************************************************
00103 !
00104 !
00105 !
00106 !
00107 !
00108 !
00109 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00110 !| A11            |<--| ELEMENTS OF MATRIX
00111 !| A12            |<--| ELEMENTS OF MATRIX
00112 !| A13            |<--| ELEMENTS OF MATRIX
00113 !| A14            |<--| ELEMENTS OF MATRIX
00114 !| A21            |<--| ELEMENTS OF MATRIX
00115 !| A22            |<--| ELEMENTS OF MATRIX
00116 !| A23            |<--| ELEMENTS OF MATRIX
00117 !| A24            |<--| ELEMENTS OF MATRIX
00118 !| A31            |<--| ELEMENTS OF MATRIX
00119 !| A32            |<--| ELEMENTS OF MATRIX
00120 !| A33            |<--| ELEMENTS OF MATRIX
00121 !| A34            |<--| ELEMENTS OF MATRIX
00122 !| A41            |<--| ELEMENTS OF MATRIX
00123 !| A42            |<--| ELEMENTS OF MATRIX
00124 !| A43            |<--| ELEMENTS OF MATRIX
00125 !| A44            |<--| ELEMENTS OF MATRIX
00126 !| F              |-->| FUNCTION USED IN THE FORMULA
00127 !| ICOORD         |-->| 1: DERIVATIVE ALONG X, 2: ALONG Y
00128 !| IKLE1          |-->| FIRST POINTS OF TRIANGLES
00129 !| IKLE2          |-->| SECOND POINTS OF TRIANGLES
00130 !| IKLE3          |-->| THIRD POINTS OF TRIANGLES
00131 !| IKLE4          |-->| FOURTH POINTS OF TRIANGLES (QUADRATIC)
00132 !| IKLE5          |-->| FIFTH POINTS OF TRIANGLES (QUADRATIC)
00133 !| IKLE6          |-->| SIXTH POINTS OF TRIANGLES (QUADRATIC)
00134 !| NELEM          |-->| NUMBER OF ELEMENTS
00135 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00136 !| SF             |-->| STRUCTURE OF FUNCTIONS F
00137 !| XEL            |-->| ABSCISSAE OF POINTS IN THE MESH, PER ELEMENT
00138 !| YEL            |-->| ORDINATES OF POINTS IN THE MESH, PER ELEMENT
00139 !| XMUL           |-->| MULTIPLICATION FACTOR
00140 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00141 !
00142       USE BIEF, EX_MT11BB => MT11BB
00143 !
00144       IMPLICIT NONE
00145       INTEGER LNG,LU
00146       COMMON/INFO/LNG,LU
00147 !
00148 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00149 !
00150       INTEGER, INTENT(IN) :: NELEM,NELMAX,ICOORD
00151       INTEGER, INTENT(IN) :: IKLE1(NELMAX),IKLE2(NELMAX)
00152       INTEGER, INTENT(IN) :: IKLE3(NELMAX),IKLE4(NELMAX)
00153 !
00154       DOUBLE PRECISION, INTENT(INOUT) :: A11(*),A12(*),A13(*),A14(*)
00155       DOUBLE PRECISION, INTENT(INOUT) :: A21(*),A22(*),A23(*),A24(*)
00156       DOUBLE PRECISION, INTENT(INOUT) :: A31(*),A32(*),A33(*),A34(*)
00157       DOUBLE PRECISION, INTENT(INOUT) :: A41(*),A42(*),A43(*),A44(*)
00158 !
00159       DOUBLE PRECISION, INTENT(IN) :: XMUL
00160       DOUBLE PRECISION, INTENT(IN) :: F(*)
00161 !
00162 !     STRUCTURE OF F
00163       TYPE(BIEF_OBJ), INTENT(IN) :: SF
00164 !
00165       DOUBLE PRECISION, INTENT(IN) :: XEL(NELMAX,3),YEL(NELMAX,3)
00166 !
00167 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00168 !
00169       INTEGER IELEM,IELMF
00170       DOUBLE PRECISION X2,X3,Y2,Y3,F1,F2,F3,F4
00171       DOUBLE PRECISION XSUR72,XSUR24,XSU216
00172 !
00173 !-----------------------------------------------------------------------
00174 !
00175       XSUR72 = XMUL/72.D0
00176       XSUR24 = XMUL/24.D0
00177       XSU216 = XMUL/216.D0
00178 !
00179       IELMF=SF%ELM
00180 !
00181 !-----------------------------------------------------------------------
00182 !  CASE WHERE F IS OF TYPE P1
00183 !-----------------------------------------------------------------------
00184 !
00185       IF(IELMF.EQ.11) THEN
00186 !
00187 !================================
00188 !  DERIVATIVE WRT X  =
00189 !================================
00190 !
00191         IF(ICOORD.EQ.1) THEN
00192 !
00193 !   LOOP ON THE ELEMENTS
00194 !
00195         DO IELEM = 1 , NELEM
00196 !
00197 !   INITIALISES THE GEOMETRICAL VARIABLES
00198 !
00199         Y2 = YEL(IELEM,2)
00200         Y3 = YEL(IELEM,3)
00201 !
00202         F1  =  F(IKLE1(IELEM))
00203         F2  =  F(IKLE2(IELEM))
00204         F3  =  F(IKLE3(IELEM))
00205 !
00206 !   EXTRADIAGONAL TERMS
00207 !
00208       A12(IELEM) = (Y2*(F3-14*F2-11*F1)+Y3*(F3+4*F2+7*F1))*XSU216
00209       A13(IELEM) = (Y2*(-4*F3-F2-7*F1)+Y3*(14*F3-F2+11*F1))*XSU216
00210       A14(IELEM) = (Y2*(-F3-4*F2-7*F1)+Y3*(4*F3+F2+7*F1))*XSUR72
00211       A21(IELEM) = (2*Y2*(F3-2*F2-5*F1)+Y3*(-F3-7*F2-4*F1))*XSU216
00212       A23(IELEM) = (2*Y2*(5*F3+2*F2-F1)+Y3*(-14*F3-11*F2+F1))*XSU216
00213       A24(IELEM) = (3*Y2*(F3-F1)+Y3*(-4*F3-7*F2-F1))*XSUR72
00214       A31(IELEM) = (Y2*(7*F3+F2+4*F1)+2*Y3*(2*F3-F2+5*F1))*XSU216
00215       A32(IELEM) = (Y2*(11*F3+14*F2-F1)+2*Y3*(-2*F3-5*F2+F1))*XSU216
00216       A34(IELEM) = (Y2*(7*F3+4*F2+F1)+3*Y3*(-F2+F1))*XSUR72
00217       A41(IELEM) = (Y2*(3*F3+4*F2+5*F1)+Y3*(-4*F3-3*F2-5*F1))*XSUR72
00218       A42(IELEM) = (Y2*(-F3+F1)+Y3*(4*F3+5*F2+3*F1))*XSUR72
00219       A43(IELEM) = (Y2*(-5*F3-4*F2-3*F1)+Y3*(F2-F1))*XSUR72
00220 !
00221 !   DIAGONAL TERMS
00222 !
00223         A11(IELEM) = (Y2*(2*F3-3*F2-11*F1)+Y3*(3*F3-2*F2+11*F1
00224      &                ))*XSUR72
00225         A22(IELEM) = (5*Y2*(F3-F1)+Y3*(-3*F3-11*F2+2*F1))*XSUR72
00226         A33(IELEM) = (Y2*(11*F3+3*F2-2*F1)+5*Y3*(-F2+F1))*XSUR72
00227         A44(IELEM) = (Y2*(F3-F1)+Y3*(-F2+F1))*XSUR24
00228 !
00229       ENDDO ! IELEM
00230 !
00231         ELSEIF(ICOORD.EQ.2) THEN
00232 !
00233 !================================
00234 !  DERIVATIVE WRT Y  =
00235 !================================
00236 !
00237         DO IELEM = 1 , NELEM
00238 !
00239 !   INITIALISES THE GEOMETRICAL VARIABLES
00240 !
00241         X2  =  XEL(IELEM,2)
00242         X3  =  XEL(IELEM,3)
00243 !
00244         F1  =  F(IKLE1(IELEM))
00245         F2  =  F(IKLE2(IELEM))
00246         F3  =  F(IKLE3(IELEM))
00247 !
00248 !   EXTRADIAGONAL TERMS
00249 !
00250       A12(IELEM) = (X2*(-F3+14*F2+11*F1)+X3*(-F3-4*F2-7*F1))*XSU216
00251       A13(IELEM) = (X2*(4*F3+F2+7*F1)+X3*(-14*F3+F2-11*F1))*XSU216
00252       A14(IELEM) = (X2*(F3+4*F2+7*F1)+X3*(-4*F3-F2-7*F1))*XSUR72
00253       A21(IELEM) = (2*X2*(-F3+2*F2+5*F1)+X3*(F3+7*F2+4*F1))*XSU216
00254       A23(IELEM) = (2*X2*(-5*F3-2*F2+F1)+X3*(14*F3+11*F2-F1))*XSU216
00255       A24(IELEM) = (3*X2*(-F3+F1)+X3*(4*F3+7*F2+F1))*XSUR72
00256       A31(IELEM) = (X2*(-7*F3-F2-4*F1)+2*X3*(-2*F3+F2-5*F1))*XSU216
00257       A32(IELEM) = (X2*(-11*F3-14*F2+F1)+2*X3*(2*F3+5*F2-F1))*XSU216
00258       A34(IELEM) = (X2*(-7*F3-4*F2-F1)+3*X3*(F2-F1))*XSUR72
00259       A41(IELEM) = (X2*(-3*F3-4*F2-5*F1)+X3*(4*F3+3*F2+5*F1))*XSUR72
00260       A42(IELEM) = (X2*(F3-F1)+X3*(-4*F3-5*F2-3*F1))*XSUR72
00261       A43(IELEM) = (X2*(5*F3+4*F2+3*F1)+X3*(-F2+F1))*XSUR72
00262 !
00263 !   DIAGONAL TERMS
00264 !
00265         A11(IELEM) = (X2*(-2*F3+3*F2+11*F1)+X3*(-3*F3+2*F2-11*
00266      &                F1))*XSUR72
00267         A22(IELEM) = (5*X2*(-F3+F1)+X3*(3*F3+11*F2-2*F1))*XSUR72
00268         A33(IELEM) = (X2*(-11*F3-3*F2+2*F1)+5*X3*(F2-F1))*XSUR72
00269         A44(IELEM) = (X2*(-F3+F1)+X3*(F2-F1))*XSUR24
00270 !
00271         ENDDO ! IELEM
00272 !
00273         ELSE
00274 !
00275           IF (LNG.EQ.1) WRITE(LU,200) ICOORD
00276           IF (LNG.EQ.2) WRITE(LU,201) ICOORD
00277           CALL PLANTE(0)
00278           STOP
00279         ENDIF
00280 !
00281 !
00282 !-----------------------------------------------------------------------
00283 !  CASE WHERE F IS OF TYPE QUASI-BUBBLE
00284 !-----------------------------------------------------------------------
00285 !
00286       ELSEIF(IELMF.EQ.12) THEN
00287 !
00288 !================================
00289 !  DERIVATIVE WRT X  =
00290 !================================
00291 !
00292         IF(ICOORD.EQ.1) THEN
00293 !
00294 !   LOOP ON THE ELEMENTS
00295 !
00296         DO IELEM = 1 , NELEM
00297 !
00298 !   INITIALISES THE GEOMETRICAL VARIABLES
00299 !
00300         Y2 = YEL(IELEM,2)
00301         Y3 = YEL(IELEM,3)
00302 !
00303         F1  =  F(IKLE1(IELEM))
00304         F2  =  F(IKLE2(IELEM))
00305         F3  =  F(IKLE3(IELEM))
00306         F4  =  F(IKLE4(IELEM))
00307 !
00308 !   EXTRADIAGONAL TERMS
00309 !
00310         A12(IELEM) = (Y2*(F4-5*F2-4*F1)+Y3*(F4+F2+2*F1))*XSUR72
00311         A13(IELEM) = (Y2*(-F3-F4-2*F1)+Y3*(5*F3-F4+4*F1))*XSUR72
00312         A14(IELEM) = (Y2*(-F4-F2-2*F1)+Y3*(F3+F4+2*F1))*XSUR24
00313         A21(IELEM) = (2*Y2*(F4-F2-2*F1)+Y3*(-F4-2*F2-F1))*XSUR72
00314         A23(IELEM) = (2*Y2*(2*F3-F4+F2)+Y3*(-5*F3+F4-4*F2))*XSUR72
00315         A24(IELEM) = (Y2*(F3-F1)+Y3*(-F3-F4-2*F2))*XSUR24
00316         A31(IELEM) = (Y2*(2*F3+F4+F1)+2*Y3*(F3-F4+2*F1))*XSUR72
00317         A32(IELEM) = (Y2*(4*F3-F4+5*F2)+2*Y3*(-F3+F4-2*F2))*XSUR72
00318         A34(IELEM) = (Y2*(2*F3+F4+F2)+Y3*(-F2+F1))*XSUR24
00319         A41(IELEM) = (Y2*(F3+6*F4+2*F2+3*F1)+Y3*(-2*F3-6*F4-F2-3*F1)
00320      &              )*XSUR72
00321         A42(IELEM) = (Y2*(-F3+F1)+Y3*(2*F3+6*F4+3*F2+F1))*XSUR72
00322         A43(IELEM) = (Y2*(-3*F3-6*F4-2*F2-F1)+Y3*(F2-F1))*XSUR72
00323 !
00324 !   DIAGONAL TERMS
00325 !
00326         A11(IELEM) = (Y2*(F3+3*F4-4*F2-12*F1)+Y3*(4*F3-3*F4-F2+
00327      &               12*F1))*XSUR72
00328         A22(IELEM) = (5*Y2*(F3-F1)+Y3*(-4*F3+3*F4-12*F2+F1))*XSUR72
00329         A33(IELEM) = (Y2*(12*F3-3*F4+4*F2-F1)+5*Y3*(-F2+F1))*XSUR72
00330         A44(IELEM) = (Y2*(F3-F1)+Y3*(-F2+F1))*XSUR24
00331 !
00332         ENDDO ! IELEM
00333 !
00334         ELSEIF(ICOORD.EQ.2) THEN
00335 !
00336 !================================
00337 !  DERIVATIVE WRT Y  =
00338 !================================
00339 !
00340         DO IELEM = 1 , NELEM
00341 !
00342 !   INITIALISES THE GEOMETRICAL VARIABLES
00343 !
00344         X2  =  XEL(IELEM,2)
00345         X3  =  XEL(IELEM,3)
00346 !
00347         F1  =  F(IKLE1(IELEM))
00348         F2  =  F(IKLE2(IELEM))
00349         F3  =  F(IKLE3(IELEM))
00350         F4  =  F(IKLE4(IELEM))
00351 !
00352 !   EXTRADIAGONAL TERMS
00353 !
00354 !   EXTRADIAGONAL TERMS
00355 !
00356       A12(IELEM) = (X2*(-F4+5*F2+4*F1)+X3*(-F4-F2-2*F1))*XSUR72
00357       A13(IELEM) = (X2*(F3+F4+2*F1)+X3*(-5*F3+F4-4*F1))*XSUR72
00358       A14(IELEM) = (X2*(F4+F2+2*F1)+X3*(-F3-F4-2*F1))*XSUR24
00359       A21(IELEM) = (2*X2*(-F4+F2+2*F1)+X3*(F4+2*F2+F1))*XSUR72
00360       A23(IELEM) = (2*X2*(-2*F3+F4-F2)+X3*(5*F3-F4+4*F2))*XSUR72
00361       A24(IELEM) = (X2*(-F3+F1)+X3*(F3+F4+2*F2))*XSUR24
00362       A31(IELEM) = (X2*(-2*F3-F4-F1)+2*X3*(-F3+F4-2*F1))*XSUR72
00363       A32(IELEM) = (X2*(-4*F3+F4-5*F2)+2*X3*(F3-F4+2*F2))*XSUR72
00364       A34(IELEM) = (X2*(-2*F3-F4-F2)+X3*(F2-F1))*XSUR24
00365       A41(IELEM) = (X2*(-F3-6*F4-2*F2-3*F1)+X3*(2*F3+6*F4+F2+3*F1)
00366      &            )*XSUR72
00367       A42(IELEM) = (X2*(F3-F1)+X3*(-2*F3-6*F4-3*F2-F1))*XSUR72
00368       A43(IELEM) = (X2*(3*F3+6*F4+2*F2+F1)+X3*(-F2+F1))*XSUR72
00369 !
00370 !   DIAGONAL TERMS
00371 !
00372         A11(IELEM) = (X2*(-F3-3*F4+4*F2+12*F1)+X3*(-4*F3+3*F4+
00373      &                F2-12*F1))*XSUR72
00374         A22(IELEM) = (5*X2*(-F3+F1)+X3*(4*F3-3*F4+12*F2-F1))*XSUR72
00375         A33(IELEM) = (X2*(-12*F3+3*F4-4*F2+F1)+5*X3*(F2-F1))*XSUR72
00376         A44(IELEM) = (X2*(-F3+F1)+X3*(F2-F1))*XSUR24
00377 !
00378         ENDDO ! IELEM
00379 !
00380         ELSE
00381 !
00382           IF (LNG.EQ.1) WRITE(LU,200) ICOORD
00383           IF (LNG.EQ.2) WRITE(LU,201) ICOORD
00384           CALL PLANTE(0)
00385           STOP
00386         ENDIF
00387 !
00388 !-----------------------------------------------------------------------
00389 !
00390       ELSE
00391         IF (LNG.EQ.1) WRITE(LU,100) IELMF
00392         IF (LNG.EQ.2) WRITE(LU,101) IELMF
00393 100     FORMAT(1X,'MT11BB (BIEF) :',/,
00394      &         1X,'DISCRETISATION DE F : ',1I6,' NON PREVUE')
00395 101     FORMAT(1X,'MT11BB (BIEF) :',/,
00396      &         1X,'DISCRETIZATION OF F : ',1I6,' NOT AVAILABLE')
00397         CALL PLANTE(0)
00398         STOP
00399       ENDIF
00400 !
00401 200       FORMAT(1X,'MT11BB (BIEF) : COMPOSANTE IMPOSSIBLE ',
00402      &              1I6,' VERIFIER ICOORD')
00403 201       FORMAT(1X,'MT11BB (BIEF) : IMPOSSIBLE COMPONENT ',
00404      &              1I6,' CHECK ICOORD')
00405 !
00406 !-----------------------------------------------------------------------
00407 !
00408       RETURN
00409       END

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