mt11ab.f

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

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