mt11ba.f

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