mt08ba.f

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

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