mt08bb.f

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

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