mt12ba.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mt12ba.f
00002 !
00076                      SUBROUTINE MT12BA
00077 !                    *****************
00078 !
00079      &(  A11 , A12 , A13 ,
00080      &   A21 , A22 , A23 ,
00081      &   A31 , A32 , A33 ,
00082      &   A41 , A42 , A43 ,
00083      &   XMUL,SF,SU,SV,F,U,V,
00084      &   XEL,YEL,SURFAC,
00085      &   IKLE1,IKLE2,IKLE3,IKLE4,
00086      &   NELEM,NELMAX,ICOORD)
00087 !
00088 !***********************************************************************
00089 ! BIEF   V6P1                                   21/08/2010
00090 !***********************************************************************
00091 !
00092 !
00093 !
00094 !
00095 !
00096 !
00097 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00098 !| A11            |<--| ELEMENTS OF MATRIX
00099 !| A12            |<--| ELEMENTS OF MATRIX
00100 !| A13            |<--| ELEMENTS OF MATRIX
00101 !| A21            |<--| ELEMENTS OF MATRIX
00102 !| A22            |<--| ELEMENTS OF MATRIX
00103 !| A23            |<--| ELEMENTS OF MATRIX
00104 !| A31            |<--| ELEMENTS OF MATRIX
00105 !| A32            |<--| ELEMENTS OF MATRIX
00106 !| A33            |<--| ELEMENTS OF MATRIX
00107 !| A41            |<--| ELEMENTS OF MATRIX
00108 !| A42            |<--| ELEMENTS OF MATRIX
00109 !| A43            |<--| 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 !| IKLE4          |-->| FOURTH POINTS OF TRIANGLES (QUADRATIC)
00116 !| IKLE5          |-->| FIFTH POINTS OF TRIANGLES (QUADRATIC)
00117 !| IKLE6          |-->| SIXTH POINTS OF TRIANGLES (QUADRATIC)
00118 !| NELEM          |-->| NUMBER OF ELEMENTS
00119 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00120 !| SF             |-->| STRUCTURE OF FUNCTIONS F
00121 !| XEL            |-->| ABSCISSAE OF POINTS IN THE MESH, PER ELEMENT
00122 !| YEL            |-->| ORDINATES OF POINTS IN THE MESH, PER ELEMENT
00123 !| XMUL           |-->| MULTIPLICATION FACTOR
00124 !| F              |-->| FUNCTION USED IN THE FORMULA
00125 !| ICOORD         |-->| 1: DERIVATIVE ALONG X, 2: ALONG Y
00126 !| IKLE1          |-->| FIRST POINTS OF TRIANGLES
00127 !| IKLE2          |-->| SECOND POINTS OF TRIANGLES
00128 !| IKLE3          |-->| THIRD POINTS OF TRIANGLES
00129 !| IKLE4          |-->| QUASI-BUBBLE POINT
00130 !| NELEM          |-->| NUMBER OF ELEMENTS
00131 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00132 !| SF             |-->| STRUCTURE OF FUNCTIONS F
00133 !| SU             |-->| BIEF_OBJ STRUCTURE OF U
00134 !| SURFAC         |-->| AREA OF TRIANGLES
00135 !| SV             |-->| BIEF_OBJ STRUCTURE OF V
00136 !| U              |-->| FUNCTION U USED IN THE FORMULA
00137 !| V              |-->| FUNCTION V USED IN THE FORMULA
00138 !| XEL            |-->| ABSCISSAE OF POINTS IN THE MESH, PER ELEMENT
00139 !| YEL            |-->| ORDINATES OF POINTS IN THE MESH, PER ELEMENT
00140 !| XMUL           |-->| MULTIPLICATION FACTOR
00141 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00142 !
00143       USE BIEF, EX_MT12BA => MT12BA
00144 !
00145       IMPLICIT NONE
00146       INTEGER LNG,LU
00147       COMMON/INFO/LNG,LU
00148 !
00149 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00150 !
00151       INTEGER, INTENT(IN) :: NELEM,NELMAX,ICOORD
00152       INTEGER, INTENT(IN) :: IKLE1(NELMAX),IKLE2(NELMAX)
00153       INTEGER, INTENT(IN) :: IKLE3(NELMAX),IKLE4(NELMAX)
00154 !
00155       DOUBLE PRECISION, INTENT(INOUT) :: A11(*),A12(*),A13(*)
00156       DOUBLE PRECISION, INTENT(INOUT) :: A21(*),A22(*),A23(*)
00157       DOUBLE PRECISION, INTENT(INOUT) :: A31(*),A32(*),A33(*)
00158       DOUBLE PRECISION, INTENT(INOUT) :: A41(*),A42(*),A43(*)
00159 !
00160       DOUBLE PRECISION, INTENT(IN) :: XMUL
00161       DOUBLE PRECISION, INTENT(IN) :: F(*),U(*),V(*)
00162 !
00163 !     STRUCTURES OF F, U, V
00164       TYPE(BIEF_OBJ), INTENT(IN) :: SF,SU,SV
00165 !
00166 !
00167       DOUBLE PRECISION, INTENT(IN) :: XEL(NELMAX,3),YEL(NELMAX,3)
00168       DOUBLE PRECISION, INTENT(IN) :: SURFAC(NELMAX)
00169 !
00170 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00171 !
00172       INTEGER IELEM,IELMF,IELMU,IELMV
00173       DOUBLE PRECISION X2,X3,Y2,Y3,F1,F2,F3,F4
00174       DOUBLE PRECISION U1,U2,U3,V1,V2,V3,UX,UY,AUX108,XSU108,AUX036
00175       DOUBLE PRECISION AX1296,XS1296,XSUR36,AUX432,XSU432
00176 !
00177 !-----------------------------------------------------------------------
00178 !
00179       IELMF=SF%ELM
00180       IELMU=SU%ELM
00181       IELMV=SV%ELM
00182 !
00183       XSUR36 = XMUL /  36.D0
00184       XSU108 = XMUL / 108.D0
00185       XSU432 = XMUL / 432.D0
00186       XS1296 = XMUL /1296.D0
00187 !
00188 !-----------------------------------------------------------------------
00189 !  CASE WHERE F IS OF TYPE P1
00190 !-----------------------------------------------------------------------
00191 !
00192       IF(IELMF.EQ.12) THEN
00193 !
00194       IF(IELMU.EQ.10.AND.IELMV.EQ.10) THEN
00195 !
00196 !================================
00197 !  DERIVATIVE WRT X  =
00198 !================================
00199 !
00200         IF(ICOORD.EQ.1) THEN
00201 !
00202 !   LOOP ON THE ELEMENTS
00203 !
00204         DO IELEM = 1 , NELEM
00205 !
00206 !   INITIALISES THE GEOMETRICAL VARIABLES
00207 !
00208         X2 = XEL(IELEM,2)
00209         X3 = XEL(IELEM,3)
00210         Y2 = YEL(IELEM,2)
00211         Y3 = YEL(IELEM,3)
00212 !
00213         F1  =  F(IKLE1(IELEM))
00214         F2  =  F(IKLE2(IELEM)) - F1
00215         F3  =  F(IKLE3(IELEM)) - F1
00216         F4  =  F(IKLE4(IELEM)) - F1
00217 !
00218         UX  =  U(IELEM)
00219         UY  =  V(IELEM)
00220 !
00221         AUX108 = XSU108 / SURFAC(IELEM)
00222         AUX036 = XSUR36 / SURFAC(IELEM)
00223 !
00224 !   EXTRADIAGONAL TERMS
00225 !
00226       A12(IELEM)=((((F3-3*F4)*Y3+Y2*F3)*X2*UY-2*((F3-3*F4)*Y3
00227      & +Y2*F3)*X3*UY+8*((3*F4-F2)*Y2-Y3*F2)*X2*UY-4*((3*F4-
00228      & F2)*Y2-Y3*F2)*X3*UY+(Y3*F3-3*Y3*F4+Y2*F3)*(2*Y3-Y2)*UX-
00229      & 4*(Y3*F2-3*Y2*F4+Y2*F2)*(Y3-2*Y2)*UX))*AUX108
00230       A13(IELEM)=((4*((F3-3*F4)*Y3+Y2*F3)*X2*UY-8*((F3-3*F4)
00231      & *Y3+Y2*F3)*X3*UY+2*((3*F4-F2)*Y2-Y3*F2)*X2*UY-((3*F4-
00232      & F2)*Y2-Y3*F2)*X3*UY+4*(Y3*F3-3*Y3*F4+Y2*F3)*(2*Y3-Y2)*
00233      & UX-(Y3*F2-3*Y2*F4+Y2*F2)*(Y3-2*Y2)*UX))*AUX108
00234       A21(IELEM)=(-(((2*F3-3*F4+F2)*Y2-(F3-3*F4+2*F2)*Y3)*X2
00235      & *UY-2*((2*F3-3*F4+F2)*Y2-(F3-3*F4+2*F2)*Y3)*X3*UY-4
00236      & *((3*F4-F2)*Y2-Y3*F2)*X2*UY-4*((3*F4-F2)*Y2-Y3*F2)*X3*
00237      & UY-(Y3*F3-3*Y3*F4+2*Y3*F2-2*Y2*F3+3*Y2*F4-Y2*F2)*(2*
00238      & Y3-Y2)*UX-4*(Y3*F2-3*Y2*F4+Y2*F2)*(Y3+Y2)*UX))*AUX108
00239       A23(IELEM)=(-(4*((2*F3-3*F4+F2)*Y2-(F3-3*F4+2*F2)*Y3)
00240      & *X2*UY-8*((2*F3-3*F4+F2)*Y2-(F3-3*F4+2*F2)*Y3)*X3*UY
00241      & -((3*F4-F2)*Y2-Y3*F2)*X2*UY-((3*F4-F2)*Y2-Y3*F2)*X3*UY-
00242      & 4*(Y3*F3-3*Y3*F4+2*Y3*F2-2*Y2*F3+3*Y2*F4-Y2*F2)*(2*
00243      & Y3-Y2)*UX-(Y3*F2-3*Y2*F4+Y2*F2)*(Y3+Y2)*UX))*AUX108
00244       A31(IELEM)=(-(2*((2*F3-3*F4+F2)*Y2-(F3-3*F4+2*F2)*Y3)
00245      & *X2*UY-((2*F3-3*F4+F2)*Y2-(F3-3*F4+2*F2)*Y3)*X3*UY+4
00246      & *((F3-3*F4)*Y3+Y2*F3)*X2*UY+4*((F3-3*F4)*Y3+Y2*F3)*X3*
00247      & UY-(Y3*F3-3*Y3*F4+2*Y3*F2-2*Y2*F3+3*Y2*F4-Y2*F2)*(Y3-
00248      & 2*Y2)*UX-4*(Y3*F3-3*Y3*F4+Y2*F3)*(Y3+Y2)*UX))*AUX108
00249       A32(IELEM)=(-(8*((2*F3-3*F4+F2)*Y2-(F3-3*F4+2*F2)*Y3)
00250      & *X2*UY-4*((2*F3-3*F4+F2)*Y2-(F3-3*F4+2*F2)*Y3)*X3*UY
00251      & +((F3-3*F4)*Y3+Y2*F3)*X2*UY+((F3-3*F4)*Y3+Y2*F3)*X3*UY-
00252      & 4*(Y3*F3-3*Y3*F4+2*Y3*F2-2*Y2*F3+3*Y2*F4-Y2*F2)*(Y3-
00253      & 2*Y2)*UX-(Y3*F3-3*Y3*F4+Y2*F3)*(Y3+Y2)*UX))*AUX108
00254       A41(IELEM)=(-(X2*UY*Y3*F3-3*X2*UY*Y3*F4-2*X2*UY*Y3*F2-2
00255      & *X2*UY*Y2*F3+15*X2*UY*Y2*F4-5*X2*UY*Y2*F2-5*X3*UY*Y3*
00256      & F3+15*X3*UY*Y3*F4-2*X3*UY*Y3*F2-2*X3*UY*Y2*F3-3*X3*UY
00257      & *Y2*F4+X3*UY*Y2*F2+5*UX*Y3**2*F3-15*UX*Y3**2*F4+2*UX*
00258      & Y3**2*F2+UX*Y3*Y2*F3+6*UX*Y3*Y2*F4+UX*Y3*Y2*F2+2*UX*Y2
00259      & **2*F3-15*UX*Y2**2*F4+5*UX*Y2**2*F2))*AUX036
00260       A42(IELEM)=((4*((2*F3-3*F4+F2)*Y2-(F3-3*F4+2*F2)*Y3)*
00261      & X2*UY-4*((2*F3-3*F4+F2)*Y2-(F3-3*F4+2*F2)*Y3)*X3*UY+
00262      & ((F3-3*F4)*Y3+Y2*F3)*X3*UY-((F3-3*F4)*Y3+Y2*F3)*UX*Y3-
00263      & 4*((3*F4-F2)*Y2-Y3*F2)*X2*UY+4*((3*F4-F2)*Y2-Y3*F2)*UX
00264      & *Y2-4*(Y3*F3-3*Y3*F4+2*Y3*F2-2*Y2*F3+3*Y2*F4-Y2*F2)*
00265      & (Y3-Y2)*UX))*AUX036
00266       A43(IELEM)=((4*((2*F3-3*F4+F2)*Y2-(F3-3*F4+2*F2)*Y3)*
00267      & X2*UY-4*((2*F3-3*F4+F2)*Y2-(F3-3*F4+2*F2)*Y3)*X3*UY+
00268      & 4*((F3-3*F4)*Y3+Y2*F3)*X3*UY-4*((F3-3*F4)*Y3+Y2*F3)*UX
00269      & *Y3-((3*F4-F2)*Y2-Y3*F2)*X2*UY+((3*F4-F2)*Y2-Y3*F2)*UX*
00270      & Y2-4*(Y3*F3-3*Y3*F4+2*Y3*F2-2*Y2*F3+3*Y2*F4-Y2*F2)*(
00271      & Y3-Y2)*UX))*AUX036
00272 !
00273 !   DIAGONAL TERMS
00274 !   THE SUM OF EACH COLUMN IS 0
00275 !
00276         A11(IELEM) = - A21(IELEM) - A31(IELEM) - A41(IELEM)
00277         A22(IELEM) = - A12(IELEM) - A32(IELEM) - A42(IELEM)
00278         A33(IELEM) = - A13(IELEM) - A23(IELEM) - A43(IELEM)
00279 !
00280       ENDDO ! IELEM
00281 !
00282         ELSEIF(ICOORD.EQ.2) THEN
00283 !
00284 !================================
00285 !  DERIVATIVE WRT Y  =
00286 !================================
00287 !
00288         DO IELEM = 1 , NELEM
00289 !
00290 !   INITIALISES THE GEOMETRICAL VARIABLES
00291 !
00292         X2  =  XEL(IELEM,2)
00293         X3  =  XEL(IELEM,3)
00294         Y2  =  YEL(IELEM,2)
00295         Y3  =  YEL(IELEM,3)
00296 !
00297         F1  =  F(IKLE1(IELEM))
00298         F2  =  F(IKLE2(IELEM)) - F1
00299         F3  =  F(IKLE3(IELEM)) - F1
00300         F4  =  F(IKLE4(IELEM)) - F1
00301 !
00302         UX  =  U(IELEM)
00303         UY  =  V(IELEM)
00304 !
00305         AUX108 = XSU108 / SURFAC(IELEM)
00306         AUX036 = XSUR36 / SURFAC(IELEM)
00307 !
00308 !   EXTRADIAGONAL TERMS
00309 !
00310       A12(IELEM)=(-(X2**2*UY*F3+24*X2**2*UY*F4-8*X2**2*UY*F2-
00311      & X2*X3*UY*F3-15*X2*X3*UY*F4-4*X2*X3*UY*F2+2*X2*UX*Y3*F3
00312      & +12*X2*UX*Y3*F4-4*X2*UX*Y3*F2-X2*UX*Y2*F3-24*X2*UX*Y2*
00313      & F4+8*X2*UX*Y2*F2-2*X3**2*UY*F3+6*X3**2*UY*F4+4*X3**2*
00314      & UY*F2+2*X3*UX*Y3*F3-6*X3*UX*Y3*F4-4*X3*UX*Y3*F2-X3*UX*
00315      & Y2*F3+3*X3*UX*Y2*F4+8*X3*UX*Y2*F2))*AUX108
00316       A13(IELEM)=(-(4*X2**2*UY*F3+6*X2**2*UY*F4-2*X2**2*UY*F2
00317      & -4*X2*X3*UY*F3-15*X2*X3*UY*F4-X2*X3*UY*F2+8*X2*UX*Y3*
00318      & F3+3*X2*UX*Y3*F4-X2*UX*Y3*F2-4*X2*UX*Y2*F3-6*X2*UX*Y2*
00319      & F4+2*X2*UX*Y2*F2-8*X3**2*UY*F3+24*X3**2*UY*F4+X3**2*UY
00320      & *F2+8*X3*UX*Y3*F3-24*X3*UX*Y3*F4-X3*UX*Y3*F2-4*X3*UX*
00321      & Y2*F3+12*X3*UX*Y2*F4+2*X3*UX*Y2*F2))*AUX108
00322       A21(IELEM)=((2*X2**2*UY*F3-15*X2**2*UY*F4+5*X2**2*UY*F2
00323      & -5*X2*X3*UY*F3-3*X2*X3*UY*F4+4*X2*X3*UY*F2+4*X2*UX*Y3
00324      & *F3+6*X2*UX*Y3*F4-2*X2*UX*Y3*F2-2*X2*UX*Y2*F3+15*X2*
00325      & UX*Y2*F4-5*X2*UX*Y2*F2+2*X3**2*UY*F3-6*X3**2*UY*F4+8*
00326      & X3**2*UY*F2-2*X3*UX*Y3*F3+6*X3*UX*Y3*F4-8*X3*UX*Y3*F2+
00327      & X3*UX*Y2*F3-3*X3*UX*Y2*F4-2*X3*UX*Y2*F2))*AUX108
00328       A23(IELEM)=((8*X2**2*UY*F3-15*X2**2*UY*F4+5*X2**2*UY*F2
00329      & -20*X2*X3*UY*F3+33*X2*X3*UY*F4-14*X2*X3*UY*F2+16*X2*
00330      & UX*Y3*F3-21*X2*UX*Y3*F4+7*X2*UX*Y3*F2-8*X2*UX*Y2*F3+
00331      & 15*X2*UX*Y2*F4-5*X2*UX*Y2*F2+8*X3**2*UY*F3-24*X3**2*UY
00332      & *F4+17*X3**2*UY*F2-8*X3*UX*Y3*F3+24*X3*UX*Y3*F4-17*X3
00333      & *UX*Y3*F2+4*X3*UX*Y2*F3-12*X3*UX*Y2*F4+7*X3*UX*Y2*F2))*AUX108
00334       A31(IELEM)=((8*X2**2*UY*F3-6*X2**2*UY*F4+2*X2**2*UY*F2+
00335      & 4*X2*X3*UY*F3-3*X2*X3*UY*F4-5*X2*X3*UY*F2-2*X2*UX*Y3*
00336      & F3-3*X2*UX*Y3*F4+X2*UX*Y3*F2-8*X2*UX*Y2*F3+6*X2*UX*Y2*
00337      & F4-2*X2*UX*Y2*F2+5*X3**2*UY*F3-15*X3**2*UY*F4+2*X3**2
00338      & *UY*F2-5*X3*UX*Y3*F3+15*X3*UX*Y3*F4-2*X3*UX*Y3*F2-2*
00339      & X3*UX*Y2*F3+6*X3*UX*Y2*F4+4*X3*UX*Y2*F2))*AUX108
00340       A32(IELEM)=((17*X2**2*UY*F3-24*X2**2*UY*F4+8*X2**2*UY*
00341      & F2-14*X2*X3*UY*F3+33*X2*X3*UY*F4-20*X2*X3*UY*F2+7*X2*
00342      & UX*Y3*F3-12*X2*UX*Y3*F4+4*X2*UX*Y3*F2-17*X2*UX*Y2*F3+
00343      & 24*X2*UX*Y2*F4-8*X2*UX*Y2*F2+5*X3**2*UY*F3-15*X3**2*UY
00344      & *F4+8*X3**2*UY*F2-5*X3*UX*Y3*F3+15*X3*UX*Y3*F4-8*X3*
00345      & UX*Y3*F2+7*X3*UX*Y2*F3-21*X3*UX*Y2*F4+16*X3*UX*Y2*F2))*AUX108
00346       A41(IELEM)=(-(2*X2**2*UY*F3-15*X2**2*UY*F4+5*X2**2*UY*
00347      & F2+X2*X3*UY*F3+6*X2*X3*UY*F4+X2*X3*UY*F2-2*X2*UX*Y3*F3-
00348      & 3*X2*UX*Y3*F4+X2*UX*Y3*F2-2*X2*UX*Y2*F3+15*X2*UX*Y2*F4-
00349      & 5*X2*UX*Y2*F2+5*X3**2*UY*F3-15*X3**2*UY*F4+2*X3**2*UY*
00350      & F2-5*X3*UX*Y3*F3+15*X3*UX*Y3*F4-2*X3*UX*Y3*F2+X3*UX*Y2
00351      & *F3-3*X3*UX*Y2*F4-2*X3*UX*Y2*F2))*AUX036
00352       A42(IELEM)=(-(8*X2**2*UY*F3-24*X2**2*UY*F4+8*X2**2*UY*
00353      & F2-11*X2*X3*UY*F3+24*X2*X3*UY*F4-8*X2*X3*UY*F2+7*X2*
00354      & UX*Y3*F3-12*X2*UX*Y3*F4+4*X2*UX*Y3*F2-8*X2*UX*Y2*F3+
00355      & 24*X2*UX*Y2*F4-8*X2*UX*Y2*F2+5*X3**2*UY*F3-15*X3**2*UY
00356      & *F4+8*X3**2*UY*F2-5*X3*UX*Y3*F3+15*X3*UX*Y3*F4-8*X3*
00357      & UX*Y3*F2+4*X3*UX*Y2*F3-12*X3*UX*Y2*F4+4*X3*UX*Y2*F2))*AUX036
00358       A43(IELEM)=(-(8*X2**2*UY*F3-15*X2**2*UY*F4+5*X2**2*UY*
00359      & F2-8*X2*X3*UY*F3+24*X2*X3*UY*F4-11*X2*X3*UY*F2+4*X2*
00360      & UX*Y3*F3-12*X2*UX*Y3*F4+4*X2*UX*Y3*F2-8*X2*UX*Y2*F3+
00361      & 15*X2*UX*Y2*F4-5*X2*UX*Y2*F2+8*X3**2*UY*F3-24*X3**2*UY
00362      & *F4+8*X3**2*UY*F2-8*X3*UX*Y3*F3+24*X3*UX*Y3*F4-8*X3*
00363      & UX*Y3*F2+4*X3*UX*Y2*F3-12*X3*UX*Y2*F4+7*X3*UX*Y2*F2))*AUX036
00364 !
00365 !   DIAGONAL TERMS
00366 !   THE SUM OF EACH COLUMN IS 0
00367 !
00368         A11(IELEM) = - A21(IELEM) - A31(IELEM) - A41(IELEM)
00369         A22(IELEM) = - A12(IELEM) - A32(IELEM) - A42(IELEM)
00370         A33(IELEM) = - A13(IELEM) - A23(IELEM) - A43(IELEM)
00371 !
00372         ENDDO ! IELEM
00373 !
00374         ELSE
00375 !
00376           IF (LNG.EQ.1) WRITE(LU,200) ICOORD
00377           IF (LNG.EQ.2) WRITE(LU,201) ICOORD
00378           CALL PLANTE(0)
00379           STOP
00380         ENDIF
00381 !
00382 !
00383       ELSEIF(IELMU.EQ.11) THEN
00384 !
00385 !================================
00386 !  DERIVATIVE WRT X  =
00387 !================================
00388 !
00389         IF(ICOORD.EQ.1) THEN
00390 !
00391 !   LOOP ON THE ELEMENTS
00392 !
00393         DO IELEM = 1 , NELEM
00394 !
00395 !   INITIALISES THE GEOMETRICAL VARIABLES
00396 !
00397         X2 = XEL(IELEM,2)
00398         X3 = XEL(IELEM,3)
00399         Y2 = YEL(IELEM,2)
00400         Y3 = YEL(IELEM,3)
00401 !
00402         F1 = F(IKLE1(IELEM))
00403         F2 = F(IKLE2(IELEM)) - F1
00404         F3 = F(IKLE3(IELEM)) - F1
00405         F4 = F(IKLE4(IELEM)) - F1
00406 !
00407         U1 = U(IKLE1(IELEM))
00408         U2 = U(IKLE2(IELEM))
00409         U3 = U(IKLE3(IELEM))
00410         V1 = V(IKLE1(IELEM))
00411         V2 = V(IKLE2(IELEM))
00412         V3 = V(IKLE3(IELEM))
00413 !
00414         AX1296 = XS1296 / SURFAC(IELEM)
00415         AUX432 = XSU432 / SURFAC(IELEM)
00416 !
00417 !   EXTRADIAGONAL TERMS
00418 !
00419       A12(IELEM)=((((F3-3*F4)*Y3+Y2*F3)*(5*V3+2*V2+5*V1)*X2-
00420      & 2*((F3-3*F4)*Y3+Y2*F3)*(5*V3+2*V2+5*V1)*X3+2*((3*F4
00421      & -F2)*Y2-Y3*F2)*(5*V3+26*V2+17*V1)*X2-((3*F4-F2)*Y2-Y3
00422      & *F2)*(5*V3+26*V2+17*V1)*X3+(Y3*F3-3*Y3*F4+Y2*F3)*(2*
00423      & Y3-Y2)*(5*U3+2*U2+5*U1)-(Y3*F2-3*Y2*F4+Y2*F2)*(Y3-2*
00424      & Y2)*(5*U3+26*U2+17*U1)))*AX1296
00425       A13(IELEM)=((((F3-3*F4)*Y3+Y2*F3)*(26*V3+5*V2+17*V1)*
00426      & X2-2*((F3-3*F4)*Y3+Y2*F3)*(26*V3+5*V2+17*V1)*X3+2*(
00427      & (3*F4-F2)*Y2-Y3*F2)*(2*V3+5*V2+5*V1)*X2-((3*F4-F2)*
00428      & Y2-Y3*F2)*(2*V3+5*V2+5*V1)*X3+(Y3*F3-3*Y3*F4+Y2*F3)*(
00429      & 2*Y3-Y2)*(26*U3+5*U2+17*U1)-(Y3*F2-3*Y2*F4+Y2*F2)*(Y3
00430      & -2*Y2)*(2*U3+5*U2+5*U1)))*AX1296
00431       A21(IELEM)=(-(((2*F3-3*F4+F2)*Y2-(F3-3*F4+2*F2)*Y3)*(
00432      & 5*V3+5*V2+2*V1)*X2-2*((2*F3-3*F4+F2)*Y2-(F3-3*F4+2
00433      & *F2)*Y3)*(5*V3+5*V2+2*V1)*X3-((3*F4-F2)*Y2-Y3*F2)*(5
00434      & *V3+17*V2+26*V1)*X2-((3*F4-F2)*Y2-Y3*F2)*(5*V3+17*V2
00435      & +26*V1)*X3-(Y3*F3-3*Y3*F4+2*Y3*F2-2*Y2*F3+3*Y2*F4-Y2
00436      & *F2)*(2*Y3-Y2)*(5*U3+5*U2+2*U1)-(Y3*F2-3*Y2*F4+Y2*F2
00437      & )*(Y3+Y2)*(5*U3+17*U2+26*U1)))*AX1296
00438       A23(IELEM)=(-(((2*F3-3*F4+F2)*Y2-(F3-3*F4+2*F2)*Y3)*(
00439      & 26*V3+17*V2+5*V1)*X2-2*((2*F3-3*F4+F2)*Y2-(F3-3*F4+
00440      & 2*F2)*Y3)*(26*V3+17*V2+5*V1)*X3-((3*F4-F2)*Y2-Y3*F2)*
00441      & (2*V3+5*V2+5*V1)*X2-((3*F4-F2)*Y2-Y3*F2)*(2*V3+5*V2
00442      & +5*V1)*X3-(Y3*F3-3*Y3*F4+2*Y3*F2-2*Y2*F3+3*Y2*F4-Y2*
00443      & F2)*(2*Y3-Y2)*(26*U3+17*U2+5*U1)-(Y3*F2-3*Y2*F4+Y2*
00444      & F2)*(Y3+Y2)*(2*U3+5*U2+5*U1)))*AX1296
00445       A31(IELEM)=(-(2*((2*F3-3*F4+F2)*Y2-(F3-3*F4+2*F2)*Y3)
00446      & *(5*V3+5*V2+2*V1)*X2-((2*F3-3*F4+F2)*Y2-(F3-3*F4+2
00447      & *F2)*Y3)*(5*V3+5*V2+2*V1)*X3+((F3-3*F4)*Y3+Y2*F3)*(
00448      & 17*V3+5*V2+26*V1)*X2+((F3-3*F4)*Y3+Y2*F3)*(17*V3+5*
00449      & V2+26*V1)*X3-(Y3*F3-3*Y3*F4+2*Y3*F2-2*Y2*F3+3*Y2*F4-
00450      & Y2*F2)*(Y3-2*Y2)*(5*U3+5*U2+2*U1)-(Y3*F3-3*Y3*F4+Y2*
00451      & F3)*(Y3+Y2)*(17*U3+5*U2+26*U1)))*AX1296
00452       A32(IELEM)=(-(2*((2*F3-3*F4+F2)*Y2-(F3-3*F4+2*F2)*Y3)
00453      & *(17*V3+26*V2+5*V1)*X2-((2*F3-3*F4+F2)*Y2-(F3-3*F4+
00454      & 2*F2)*Y3)*(17*V3+26*V2+5*V1)*X3+((F3-3*F4)*Y3+Y2*F3)*
00455      & (5*V3+2*V2+5*V1)*X2+((F3-3*F4)*Y3+Y2*F3)*(5*V3+2*V2
00456      & +5*V1)*X3-(Y3*F3-3*Y3*F4+2*Y3*F2-2*Y2*F3+3*Y2*F4-Y2*
00457      & F2)*(Y3-2*Y2)*(17*U3+26*U2+5*U1)-(Y3*F3-3*Y3*F4+Y2*
00458      & F3)*(Y3+Y2)*(5*U3+2*U2+5*U1)))*AX1296
00459       A41(IELEM)=((((2*F3-3*F4+F2)*Y2-(F3-3*F4+2*F2)*Y3)*(5
00460      & *V3+5*V2+2*V1)*X2-((2*F3-3*F4+F2)*Y2-(F3-3*F4+2*F2)
00461      & *Y3)*(5*V3+5*V2+2*V1)*X3+((F3-3*F4)*Y3+Y2*F3)*(17*V3
00462      & +5*V2+26*V1)*X3-((F3-3*F4)*Y3+Y2*F3)*(17*U3+5*U2+26
00463      & *U1)*Y3-((3*F4-F2)*Y2-Y3*F2)*(5*V3+17*V2+26*V1)*X2+((
00464      & 3*F4-F2)*Y2-Y3*F2)*(5*U3+17*U2+26*U1)*Y2-(Y3*F3-3*Y3*
00465      & F4+2*Y3*F2-2*Y2*F3+3*Y2*F4-Y2*F2)*(Y3-Y2)*(5*U3+5*U2
00466      & +2*U1)))*AUX432
00467       A42(IELEM)=((((2*F3-3*F4+F2)*Y2-(F3-3*F4+2*F2)*Y3)*(
00468      & 17*V3+26*V2+5*V1)*X2-((2*F3-3*F4+F2)*Y2-(F3-3*F4+2*
00469      & F2)*Y3)*(17*V3+26*V2+5*V1)*X3+((F3-3*F4)*Y3+Y2*F3)*(
00470      & 5*V3+2*V2+5*V1)*X3-((F3-3*F4)*Y3+Y2*F3)*(5*U3+2*U2+
00471      & 5*U1)*Y3-((3*F4-F2)*Y2-Y3*F2)*(5*V3+26*V2+17*V1)*X2+(
00472      & (3*F4-F2)*Y2-Y3*F2)*(5*U3+26*U2+17*U1)*Y2-(Y3*F3-3*
00473      & Y3*F4+2*Y3*F2-2*Y2*F3+3*Y2*F4-Y2*F2)*(Y3-Y2)*(17*U3+
00474      & 26*U2+5*U1)))*AUX432
00475       A43(IELEM)=((((2*F3-3*F4+F2)*Y2-(F3-3*F4+2*F2)*Y3)*(
00476      & 26*V3+17*V2+5*V1)*X2-((2*F3-3*F4+F2)*Y2-(F3-3*F4+2*
00477      & F2)*Y3)*(26*V3+17*V2+5*V1)*X3+((F3-3*F4)*Y3+Y2*F3)*(
00478      & 26*V3+5*V2+17*V1)*X3-((F3-3*F4)*Y3+Y2*F3)*(26*U3+5*
00479      & U2+17*U1)*Y3-((3*F4-F2)*Y2-Y3*F2)*(2*V3+5*V2+5*V1)*
00480      & X2+((3*F4-F2)*Y2-Y3*F2)*(2*U3+5*U2+5*U1)*Y2-(Y3*F3-3
00481      & *Y3*F4+2*Y3*F2-2*Y2*F3+3*Y2*F4-Y2*F2)*(Y3-Y2)*(26*U3+
00482      & 17*U2+5*U1)))*AUX432
00483 !
00484 !   DIAGONAL TERMS
00485 !   THE SUM OF EACH COLUMN IS 0
00486 !
00487         A11(IELEM) = - A21(IELEM) - A31(IELEM) - A41(IELEM)
00488         A22(IELEM) = - A12(IELEM) - A32(IELEM) - A42(IELEM)
00489         A33(IELEM) = - A13(IELEM) - A23(IELEM) - A43(IELEM)
00490 !
00491       ENDDO ! IELEM
00492 !
00493         ELSEIF(ICOORD.EQ.2) THEN
00494 !
00495 !================================
00496 !  DERIVATIVE WRT Y  =
00497 !================================
00498 !
00499         DO IELEM = 1 , NELEM
00500 !
00501 !   INITIALISES THE GEOMETRICAL VARIABLES
00502 !
00503         X2  =  XEL(IELEM,2)
00504         X3  =  XEL(IELEM,3)
00505         Y2  =  YEL(IELEM,2)
00506         Y3  =  YEL(IELEM,3)
00507 !
00508         F1  =  F(IKLE1(IELEM))
00509         F2  =  F(IKLE2(IELEM)) - F1
00510         F3  =  F(IKLE3(IELEM)) - F1
00511         F4  =  F(IKLE4(IELEM)) - F1
00512 !
00513         U1  =  U(IKLE1(IELEM))
00514         U2  =  U(IKLE2(IELEM))
00515         U3  =  U(IKLE3(IELEM))
00516         V1  =  V(IKLE1(IELEM))
00517         V2  =  V(IKLE2(IELEM))
00518         V3  =  V(IKLE3(IELEM))
00519 !
00520         AX1296 = XS1296 / SURFAC(IELEM)
00521         AUX432 = XSU432 / SURFAC(IELEM)
00522 !
00523 !   EXTRADIAGONAL TERMS
00524 !
00525       A12(IELEM)=(-(((2*Y3-Y2)*(5*U3+2*U2+5*U1)*F3-(F3+3*F4
00526      & )*(5*V3+2*V2+5*V1)*X3)*X2+((Y3-2*Y2)*(3*F4-F2)*(5*
00527      & U3+26*U2+17*U1)-(3*F4+F2)*(5*V3+26*V2+17*V1)*X3)*X2
00528      & +(2*Y3-Y2)*(F3-3*F4)*(5*U3+2*U2+5*U1)*X3-(Y3-2*Y2)*
00529      & (5*U3+26*U2+17*U1)*X3*F2-2*(F3-3*F4)*(5*V3+2*V2+5
00530      & *V1)*X3**2+2*(3*F4-F2)*(5*V3+26*V2+17*V1)*X2**2+(5*
00531      & V3+26*V2+17*V1)*X3**2*F2+(5*V3+2*V2+5*V1)*X2**2*F3))*AX1296
00532       A13(IELEM)=(-(((2*Y3-Y2)*(26*U3+5*U2+17*U1)*F3-(F3+3*
00533      & F4)*(26*V3+5*V2+17*V1)*X3)*X2+((Y3-2*Y2)*(3*F4-F2)*(
00534      & 2*U3+5*U2+5*U1)-(3*F4+F2)*(2*V3+5*V2+5*V1)*X3)*X2+(
00535      & 2*Y3-Y2)*(F3-3*F4)*(26*U3+5*U2+17*U1)*X3-(Y3-2*Y2)*(
00536      & 2*U3+5*U2+5*U1)*X3*F2-2*(F3-3*F4)*(26*V3+5*V2+17*
00537      & V1)*X3**2+2*(3*F4-F2)*(2*V3+5*V2+5*V1)*X2**2+(26*V3
00538      & +5*V2+17*V1)*X2**2*F3+(2*V3+5*V2+5*V1)*X3**2*F2))*AX1296
00539       A21(IELEM)=((((2*Y3-Y2)*(2*F3-3*F4+F2)*(5*U3+5*U2+2*
00540      & U1)-(5*F3-9*F4+4*F2)*(5*V3+5*V2+2*V1)*X3)*X2+((Y3+
00541      & Y2)*(3*F4-F2)*(5*U3+17*U2+26*U1)-(3*F4-2*F2)*(5*V3
00542      & +17*V2+26*V1)*X3)*X2-(2*Y3-Y2)*(F3-3*F4+2*F2)*(5*U3
00543      & +5*U2+2*U1)*X3-(Y3+Y2)*(5*U3+17*U2+26*U1)*X3*F2+(2*
00544      & F3-3*F4+F2)*(5*V3+5*V2+2*V1)*X2**2+2*(F3-3*F4+2*F2
00545      & )*(5*V3+5*V2+2*V1)*X3**2-(3*F4-F2)*(5*V3+17*V2+26*
00546      & V1)*X2**2+(5*V3+17*V2+26*V1)*X3**2*F2))*AX1296
00547       A23(IELEM)=((((2*Y3-Y2)*(2*F3-3*F4+F2)*(26*U3+17*U2+
00548      & 5*U1)-(5*F3-9*F4+4*F2)*(26*V3+17*V2+5*V1)*X3)*X2+((
00549      & Y3+Y2)*(3*F4-F2)*(2*U3+5*U2+5*U1)-(3*F4-2*F2)*(2*
00550      & V3+5*V2+5*V1)*X3)*X2-(2*Y3-Y2)*(F3-3*F4+2*F2)*(26*
00551      & U3+17*U2+5*U1)*X3-(Y3+Y2)*(2*U3+5*U2+5*U1)*X3*F2+(2
00552      & *F3-3*F4+F2)*(26*V3+17*V2+5*V1)*X2**2+2*(F3-3*F4+2
00553      & *F2)*(26*V3+17*V2+5*V1)*X3**2-(3*F4-F2)*(2*V3+5*V2+
00554      & 5*V1)*X2**2+(2*V3+5*V2+5*V1)*X3**2*F2))*AX1296
00555       A31(IELEM)=(-(((Y3+Y2)*(17*U3+5*U2+26*U1)*F3-(2*F3-3*
00556      & F4)*(17*V3+5*V2+26*V1)*X3)*X2-((Y3-2*Y2)*(2*F3-3*F4
00557      & +F2)*(5*U3+5*U2+2*U1)-(4*F3-9*F4+5*F2)*(5*V3+5*V2
00558      & +2*V1)*X3)*X2+(Y3+Y2)*(F3-3*F4)*(17*U3+5*U2+26*U1)*
00559      & X3+(Y3-2*Y2)*(F3-3*F4+2*F2)*(5*U3+5*U2+2*U1)*X3-2*
00560      & (2*F3-3*F4+F2)*(5*V3+5*V2+2*V1)*X2**2-(F3-3*F4+2*
00561      & F2)*(5*V3+5*V2+2*V1)*X3**2-(F3-3*F4)*(17*V3+5*V2+
00562      & 26*V1)*X3**2-(17*V3+5*V2+26*V1)*X2**2*F3))*AX1296
00563       A32(IELEM)=(-(((Y3+Y2)*(5*U3+2*U2+5*U1)*F3-(2*F3-3*F4
00564      & )*(5*V3+2*V2+5*V1)*X3)*X2-((Y3-2*Y2)*(2*F3-3*F4+F2)
00565      & *(17*U3+26*U2+5*U1)-(4*F3-9*F4+5*F2)*(17*V3+26*V2
00566      & +5*V1)*X3)*X2+(Y3+Y2)*(F3-3*F4)*(5*U3+2*U2+5*U1)*X3+
00567      & (Y3-2*Y2)*(F3-3*F4+2*F2)*(17*U3+26*U2+5*U1)*X3-2*(
00568      & 2*F3-3*F4+F2)*(17*V3+26*V2+5*V1)*X2**2-(F3-3*F4+2*
00569      & F2)*(17*V3+26*V2+5*V1)*X3**2-(F3-3*F4)*(5*V3+2*V2+
00570      & 5*V1)*X3**2-(5*V3+2*V2+5*V1)*X2**2*F3))*AX1296
00571       A41(IELEM)=(-(((Y3-Y2)*(2*F3-3*F4+F2)*(5*U3+5*U2+2*U1
00572      & )-3*(F3-2*F4+F2)*(5*V3+5*V2+2*V1)*X3)*X2+((3*F4-F2)
00573      & *(5*U3+17*U2+26*U1)*Y2+(5*V3+17*V2+26*V1)*X3*F2)*X2
00574      & +((17*V3+5*V2+26*V1)*X3-(17*U3+5*U2+26*U1)*Y3)*X2*
00575      & F3-(Y3-Y2)*(F3-3*F4+2*F2)*(5*U3+5*U2+2*U1)*X3+(2*F3
00576      & -3*F4+F2)*(5*V3+5*V2+2*V1)*X2**2+(F3-3*F4+2*F2)*(5
00577      & *V3+5*V2+2*V1)*X3**2+(F3-3*F4)*(17*V3+5*V2+26*V1)*
00578      & X3**2-(F3-3*F4)*(17*U3+5*U2+26*U1)*X3*Y3-(3*F4-F2)*(
00579      & 5*V3+17*V2+26*V1)*X2**2-(5*U3+17*U2+26*U1)*X3*Y2*F2))*AUX432
00580       A42(IELEM)=(-(((Y3-Y2)*(2*F3-3*F4+F2)*(17*U3+26*U2+5*
00581      & U1)-3*(F3-2*F4+F2)*(17*V3+26*V2+5*V1)*X3)*X2+((3*F4
00582      & -F2)*(5*U3+26*U2+17*U1)*Y2+(5*V3+26*V2+17*V1)*X3*F2
00583      & )*X2+((5*V3+2*V2+5*V1)*X3-(5*U3+2*U2+5*U1)*Y3)*X2*
00584      & F3-(Y3-Y2)*(F3-3*F4+2*F2)*(17*U3+26*U2+5*U1)*X3+(2*
00585      & F3-3*F4+F2)*(17*V3+26*V2+5*V1)*X2**2+(F3-3*F4+2*F2)
00586      & *(17*V3+26*V2+5*V1)*X3**2+(F3-3*F4)*(5*V3+2*V2+5*
00587      & V1)*X3**2-(F3-3*F4)*(5*U3+2*U2+5*U1)*X3*Y3-(3*F4-F2)
00588      & *(5*V3+26*V2+17*V1)*X2**2-(5*U3+26*U2+17*U1)*X3*Y2*
00589      & F2))*AUX432
00590       A43(IELEM)=(-(((Y3-Y2)*(2*F3-3*F4+F2)*(26*U3+17*U2+5*
00591      & U1)-3*(F3-2*F4+F2)*(26*V3+17*V2+5*V1)*X3)*X2+((3*F4
00592      & -F2)*(2*U3+5*U2+5*U1)*Y2+(2*V3+5*V2+5*V1)*X3*F2)*X2
00593      & +((26*V3+5*V2+17*V1)*X3-(26*U3+5*U2+17*U1)*Y3)*X2*
00594      & F3-(Y3-Y2)*(F3-3*F4+2*F2)*(26*U3+17*U2+5*U1)*X3+(2*
00595      & F3-3*F4+F2)*(26*V3+17*V2+5*V1)*X2**2+(F3-3*F4+2*F2)
00596      & *(26*V3+17*V2+5*V1)*X3**2+(F3-3*F4)*(26*V3+5*V2+17
00597      & *V1)*X3**2-(F3-3*F4)*(26*U3+5*U2+17*U1)*X3*Y3-(3*F4-
00598      & F2)*(2*V3+5*V2+5*V1)*X2**2-(2*U3+5*U2+5*U1)*X3*Y2*F2))*AUX432
00599 !
00600 !   DIAGONAL TERMS
00601 !   THE SUM OF EACH COLUMN IS 0
00602 !
00603         A11(IELEM) = - A21(IELEM) - A31(IELEM) - A41(IELEM)
00604         A22(IELEM) = - A12(IELEM) - A32(IELEM) - A42(IELEM)
00605         A33(IELEM) = - A13(IELEM) - A23(IELEM) - A43(IELEM)
00606 !
00607         ENDDO ! IELEM
00608 !
00609         ELSE
00610 !
00611           IF (LNG.EQ.1) WRITE(LU,200) ICOORD
00612           IF (LNG.EQ.2) WRITE(LU,201) ICOORD
00613           CALL PLANTE(0)
00614           STOP
00615         ENDIF
00616 !
00617       ELSE
00618 !
00619         IF (LNG.EQ.1) WRITE(LU,300) IELMU
00620         IF (LNG.EQ.2) WRITE(LU,301) IELMU
00621         CALL PLANTE(0)
00622         STOP
00623 !
00624       ENDIF
00625 !
00626 !-----------------------------------------------------------------------
00627 !
00628       ELSE
00629         IF (LNG.EQ.1) WRITE(LU,100) IELMF
00630         IF (LNG.EQ.2) WRITE(LU,101) IELMF
00631 100     FORMAT(1X,'MT12BA (BIEF) :',/,
00632      &         1X,'DISCRETISATION DE F : ',1I6,' NON PREVUE')
00633 101     FORMAT(1X,'MT12BA (BIEF) :',/,
00634      &         1X,'DISCRETIZATION OF F : ',1I6,' NOT AVAILABLE')
00635         CALL PLANTE(0)
00636         STOP
00637       ENDIF
00638 !
00639 200       FORMAT(1X,'MT12BA (BIEF) : COMPOSANTE IMPOSSIBLE ',
00640      &              1I6,' VERIFIER ICOORD')
00641 201       FORMAT(1X,'MT12BA (BIEF) : IMPOSSIBLE COMPONENT ',
00642      &              1I6,' CHECK ICOORD')
00643 !
00644 300    FORMAT(1X,'MT12BA (BIEF) :',/,
00645      &        1X,'DISCRETISATION DE U : ',1I6,' NON PREVUE')
00646 301    FORMAT(1X,'MT12BA (BIEF) :',/,
00647      &        1X,'DISCRETIZATION OF U : ',1I6,' NOT AVAILABLE')
00648 !
00649 !-----------------------------------------------------------------------
00650 !
00651       RETURN
00652       END

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