mt03bb.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mt03bb.f
00002 !
00071                      SUBROUTINE MT03BB
00072 !                    *****************
00073 !
00074      &( A11 , A12 , A13 , A14 ,
00075      &  A21 , A22 , A23 , A24 ,
00076      &  A31 , A32 , A33 , A34 ,
00077      &  A41 , A42 , A43 , A44 ,
00078      &  XMUL,SF,SG,SU,SV,F,G,U,V,
00079      &  XEL,YEL,IKLE1,IKLE2,IKLE3,NELEM,NELMAX)
00080 !
00081 !***********************************************************************
00082 ! BIEF   V6P1                                   21/08/2010
00083 !***********************************************************************
00084 !
00085 !
00086 !
00087 !
00088 !
00089 !
00090 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00091 !| A11            |<--| ELEMENTS OF MATRIX
00092 !| A12            |<--| ELEMENTS OF MATRIX
00093 !| A13            |<--| ELEMENTS OF MATRIX
00094 !| A14            |<--| ELEMENTS OF MATRIX
00095 !| A21            |<--| ELEMENTS OF MATRIX
00096 !| A22            |<--| ELEMENTS OF MATRIX
00097 !| A23            |<--| ELEMENTS OF MATRIX
00098 !| A24            |<--| ELEMENTS OF MATRIX
00099 !| A31            |<--| ELEMENTS OF MATRIX
00100 !| A32            |<--| ELEMENTS OF MATRIX
00101 !| A33            |<--| ELEMENTS OF MATRIX
00102 !| A34            |<--| ELEMENTS OF MATRIX
00103 !| A41            |<--| ELEMENTS OF MATRIX
00104 !| A42            |<--| ELEMENTS OF MATRIX
00105 !| A43            |<--| ELEMENTS OF MATRIX
00106 !| A44            |<--| ELEMENTS OF MATRIX
00107 !| F              |-->| FUNCTION USED IN THE FORMULA
00108 !| G              |-->| FUNCTION USED IN THE FORMULA
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 !| SG             |-->| STRUCTURE OF FUNCTIONS G
00116 !| SU             |-->| BIEF_OBJ STRUCTURE OF U
00117 !| SV             |-->| BIEF_OBJ STRUCTURE OF V
00118 !| U              |-->| FUNCTION U USED IN THE FORMULA
00119 !| V              |-->| FUNCTION V USED IN THE FORMULA
00120 !| XEL            |-->| ABSCISSAE OF POINTS IN THE MESH, PER ELEMENT
00121 !| YEL            |-->| ORDINATES OF POINTS IN THE MESH, PER ELEMENT
00122 !| XMUL           |-->| MULTIPLICATION FACTOR
00123 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00124 !
00125       USE BIEF, EX_MT03BB => MT03BB
00126 !
00127       IMPLICIT NONE
00128       INTEGER LNG,LU
00129       COMMON/INFO/LNG,LU
00130 !
00131 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00132 !
00133       INTEGER, INTENT(IN) :: NELEM,NELMAX
00134       INTEGER, INTENT(IN) :: IKLE1(NELMAX),IKLE2(NELMAX),IKLE3(NELMAX)
00135 !
00136       DOUBLE PRECISION, INTENT(INOUT) :: A11(*),A12(*),A13(*),A14(*)
00137       DOUBLE PRECISION, INTENT(INOUT) :: A21(*),A22(*),A23(*),A24(*)
00138       DOUBLE PRECISION, INTENT(INOUT) :: A31(*),A32(*),A33(*),A34(*)
00139       DOUBLE PRECISION, INTENT(INOUT) :: A41(*),A42(*),A43(*),A44(*)
00140 !
00141       DOUBLE PRECISION, INTENT(IN) :: XMUL
00142       DOUBLE PRECISION, INTENT(IN) :: F(*),G(*),U(*),V(*)
00143 !
00144 !     STRUCTURES OF      F, G, U, V
00145       TYPE(BIEF_OBJ), INTENT(IN) :: SF,SG,SU,SV
00146 !
00147       DOUBLE PRECISION, INTENT(IN) :: XEL(NELMAX,3),YEL(NELMAX,3)
00148 !
00149 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00150 !
00151 !     DECLARATIONS SPECIFIC TO THIS SUBROUTINE
00152 !
00153       INTEGER IELEM,IELMF,IELMG,IELMU,IELMV
00154 !
00155       DOUBLE PRECISION X2,X3,Y2,Y3,U1,U2,U3,U4,V1,V2,V3,V4
00156       DOUBLE PRECISION KXEL,KYEL
00157 !
00158 !-----------------------------------------------------------------------
00159 !
00160       IELMF = SF%ELM
00161       IELMG = SG%ELM
00162       IELMU = SU%ELM
00163       IELMV = SV%ELM
00164 !
00165 !-----------------------------------------------------------------------
00166 ! CASE WHERE U IS OF P1 DISCRETISATION
00167 !-----------------------------------------------------------------------
00168 !
00169       IF(IELMF.EQ.10.AND.IELMG.EQ.10.AND.
00170      &   IELMU.EQ.11.AND.IELMV.EQ.11) THEN
00171 !
00172 !   LOOP ON THE ELEMENTS
00173 !
00174       DO IELEM = 1 , NELEM
00175 !
00176       X2  =   XEL(IELEM,2)
00177       X3  =   XEL(IELEM,3)
00178       Y2  =   YEL(IELEM,2)
00179       Y3  =   YEL(IELEM,3)
00180 !
00181       U1   =  U(IKLE1(IELEM))
00182       U2   =  U(IKLE2(IELEM))
00183       U3   =  U(IKLE3(IELEM))
00184       V1   =  V(IKLE1(IELEM))
00185       V2   =  V(IKLE2(IELEM))
00186       V3   =  V(IKLE3(IELEM))
00187 !
00188       KXEL =  F(IELEM)
00189       KYEL =  G(IELEM)
00190 !
00191 ! COMPUTES 9 OF THE 16 TERMS
00192 !
00193       A11(IELEM)=
00194      &  (X2**2*KYEL*(8*V3+17*V2+20*V1)+4*X2*X3*KYEL*(-
00195      &  5*V3-5*V2-8*V1)+X2*Y2*KXEL*(-8*V3-17*V2-20*V1)+X2*Y2*
00196      &  KYEL*(-8*U3-17*U2-20*U1)+2*X2*Y3*KXEL*(5*V3+5*V2+8*V1)
00197      &  +2*X2*Y3*KYEL*(5*U3+5*U2+8*U1)+X3**2*KYEL*(17*V3+8*V2+
00198      &  20*V1)+2*X3*Y2*KXEL*(5*V3+5*V2+8*V1)+2*X3*Y2*KYEL*(5*U3
00199      &  +5*U2+8*U1)+X3*Y3*KXEL*(-17*V3-8*V2-20*V1)+X3*Y3*KYEL*(-
00200      &  17*U3-8*U2-20*U1)+Y2**2*KXEL*(8*U3+17*U2+20*U1)+4*Y2*
00201      &  Y3*KXEL*(-5*U3-5*U2-8*U1)+Y3**2*KXEL*(17*U3+8*U2+20*U1)
00202      &  )*XMUL/(54*X2*Y3-54*X3*Y2)
00203 !
00204       A12(IELEM)=
00205      & (2*X2**2*KYEL*(V3+4*V2+4*V1)+X2*X3*KYEL*(V3+4*
00206      &  V2+4*V1)+2*X2*Y2*KXEL*(-V3-4*V2-4*V1)+2*X2*Y2*KYEL*(-U3-
00207      &  4*U2-4*U1)+X2*Y3*KXEL*(V3+4*V2+4*V1)+2*X2*Y3*KYEL*(-U3-4
00208      &  *U2-4*U1)+X3**2*KYEL*(-V3-4*V2-4*V1)+2*X3*Y2*KXEL*(-V3-4
00209      &  *V2-4*V1)+X3*Y2*KYEL*(U3+4*U2+4*U1)+X3*Y3*KXEL*(V3+4*V2+
00210      &  4*V1)+X3*Y3*KYEL*(U3+4*U2+4*U1)+2*Y2**2*KXEL*(U3+4*U2+4*
00211      &  U1)+Y2*Y3*KXEL*(U3+4*U2+4*U1)+Y3**2*KXEL*(-U3-4*U2-4*U1))
00212      &  *XMUL/(54*X2*Y3-54*X3*Y2)
00213 !
00214       A13(IELEM)=
00215      &  (X2**2*KYEL*(-4*V3-V2-4*V1)+X2*X3*KYEL*(4*V3+V2+
00216      &  4*V1)+X2*Y2*KXEL*(4*V3+V2+4*V1)+X2*Y2*KYEL*(4*U3+U2+4*U1)
00217      &  +2*X2*Y3*KXEL*(-4*V3-V2-4*V1)+X2*Y3*KYEL*(4*U3+U2+4*U1)+
00218      &  2*X3**2*KYEL*(4*V3+V2+4*V1)+X3*Y2*KXEL*(4*V3+V2+4*V1)+2*
00219      &  X3*Y2*KYEL*(-4*U3-U2-4*U1)+2*X3*Y3*KXEL*(-4*V3-V2-4*V1)+
00220      &  2*X3*Y3*KYEL*(-4*U3-U2-4*U1)+Y2**2*KXEL*(-4*U3-U2-4*U1)+
00221      &  Y2*Y3*KXEL*(4*U3+U2+4*U1)+2*Y3**2*KXEL*(4*U3+U2+4*U1))
00222      &  *XMUL/(54*X2*Y3-54*X3*Y2)
00223 !
00224       A21(IELEM)=
00225      &  (2*X2**2*KYEL*(V3+4*V2+4*V1)+X2*X3*KYEL*(V3+4*
00226      &  V2+4*V1)+2*X2*Y2*KXEL*(-V3-4*V2-4*V1)+2*X2*Y2*KYEL*(-U3-
00227      &  4*U2-4*U1)+2*X2*Y3*KXEL*(-V3-4*V2-4*V1)+X2*Y3*KYEL*(U3+4
00228      &  *U2+4*U1)+X3**2*KYEL*(-V3-4*V2-4*V1)+X3*Y2*KXEL*(V3+4*V2+
00229      &  4*V1)+2*X3*Y2*KYEL*(-U3-4*U2-4*U1)+X3*Y3*KXEL*(V3+4*V2+4
00230      &  *V1)+X3*Y3*KYEL*(U3+4*U2+4*U1)+2*Y2**2*KXEL*(U3+4*U2+4*
00231      &  U1)+Y2*Y3*KXEL*(U3+4*U2+4*U1)+Y3**2*KXEL*(-U3-4*U2-4*U1))
00232      &  *XMUL/(54*X2*Y3-54*X3*Y2)
00233 !
00234       A23(IELEM)=
00235      &  (2*X2**2*KYEL*(4*V3+4*V2+V1)+5*X2*X3*KYEL*(-4*
00236      &  V3-4*V2-V1)+2*X2*Y2*KXEL*(-4*V3-4*V2-V1)+2*X2*Y2*KYEL*(-
00237      &  4*U3-4*U2-U1)+4*X2*Y3*KXEL*(4*V3+4*V2+V1)+X2*Y3*KYEL*(4*
00238      &  U3+4*U2+U1)+2*X3**2*KYEL*(4*V3+4*V2+V1)+X3*Y2*KXEL*(4*V3
00239      &  +4*V2+V1)+4*X3*Y2*KYEL*(4*U3+4*U2+U1)+2*X3*Y3*KXEL*(-4*
00240      &  V3-4*V2-V1)+2*X3*Y3*KYEL*(-4*U3-4*U2-U1)+2*Y2**2*KXEL*(
00241      &  4*U3+4*U2+U1)+5*Y2*Y3*KXEL*(-4*U3-4*U2-U1)+2*Y3**2*KXEL*
00242      &  (4*U3+4*U2+U1))*XMUL/(54*X2*Y3-54*X3*Y2)
00243 !
00244       A24(IELEM)=
00245      &  (X2**2*KYEL*(-5*V3-8*V2-5*V1)+X2*X3*KYEL*(11*V3
00246      &  +8*V2-V1)+X2*Y2*KXEL*(5*V3+8*V2+5*V1)+X2*Y2*KYEL*(5*U3+
00247      &  8*U2+5*U1)+X2*Y3*KXEL*(-7*V3-4*V2+2*V1)+X2*Y3*KYEL*(-4*
00248      &  U3-4*U2-U1)+2*X3**2*KYEL*(-4*V3-4*V2-V1)+X3*Y2*KXEL*(-4*
00249      &  V3-4*V2-V1)+X3*Y2*KYEL*(-7*U3-4*U2+2*U1)+2*X3*Y3*KXEL*(
00250      &  4*V3+4*V2+V1)+2*X3*Y3*KYEL*(4*U3+4*U2+U1)+Y2**2*KXEL*(-5
00251      &  *U3-8*U2-5*U1)+Y2*Y3*KXEL*(11*U3+8*U2-U1)+2*Y3**2*KXEL*(
00252      &  -4*U3-4*U2-U1))*XMUL/(18*X2*Y3-18*X3*Y2)
00253 !
00254       A31(IELEM)=
00255      &  (X2**2*KYEL*(-4*V3-V2-4*V1)+X2*X3*KYEL*(4*V3+V2+
00256      &  4*V1)+X2*Y2*KXEL*(4*V3+V2+4*V1)+X2*Y2*KYEL*(4*U3+U2+4*U1)
00257      &  +X2*Y3*KXEL*(4*V3+V2+4*V1)+2*X2*Y3*KYEL*(-4*U3-U2-4*U1)+
00258      &  2*X3**2*KYEL*(4*V3+V2+4*V1)+2*X3*Y2*KXEL*(-4*V3-V2-4*V1)
00259      &  +X3*Y2*KYEL*(4*U3+U2+4*U1)+2*X3*Y3*KXEL*(-4*V3-V2-4*V1)+
00260      &  2*X3*Y3*KYEL*(-4*U3-U2-4*U1)+Y2**2*KXEL*(-4*U3-U2-4*U1)+
00261      &  Y2*Y3*KXEL*(4*U3+U2+4*U1)+2*Y3**2*KXEL*(4*U3+U2+4*U1))
00262      &  *XMUL/(54*X2*Y3-54*X3*Y2)
00263 !
00264       A32(IELEM)=
00265      &  (2*X2**2*KYEL*(4*V3+4*V2+V1)+5*X2*X3*KYEL*(-4*
00266      &  V3-4*V2-V1)+2*X2*Y2*KXEL*(-4*V3-4*V2-V1)+2*X2*Y2*KYEL*(-
00267      &  4*U3-4*U2-U1)+X2*Y3*KXEL*(4*V3+4*V2+V1)+4*X2*Y3*KYEL*(4*
00268      &  U3+4*U2+U1)+2*X3**2*KYEL*(4*V3+4*V2+V1)+4*X3*Y2*KXEL*(4
00269      &  *V3+4*V2+V1)+X3*Y2*KYEL*(4*U3+4*U2+U1)+2*X3*Y3*KXEL*(-4*
00270      &  V3-4*V2-V1)+2*X3*Y3*KYEL*(-4*U3-4*U2-U1)+2*Y2**2*KXEL*(
00271      &  4*U3+4*U2+U1)+5*Y2*Y3*KXEL*(-4*U3-4*U2-U1)+2*Y3**2*KXEL*
00272      &  (4*U3+4*U2+U1))*XMUL/(54*X2*Y3-54*X3*Y2)
00273 !
00274       A34(IELEM)=
00275      &  (2*X2**2*KYEL*(-4*V3-4*V2-V1)+X2*X3*KYEL*(8*V3+
00276      &  11*V2-V1)+2*X2*Y2*KXEL*(4*V3+4*V2+V1)+2*X2*Y2*KYEL*(4*U3
00277      &  +4*U2+U1)+X2*Y3*KXEL*(-4*V3-4*V2-V1)+X2*Y3*KYEL*(-4*U3-7
00278      &  *U2+2*U1)+X3**2*KYEL*(-8*V3-5*V2-5*V1)+X3*Y2*KXEL*(-4*V3
00279      &  -7*V2+2*V1)+X3*Y2*KYEL*(-4*U3-4*U2-U1)+X3*Y3*KXEL*(8*V3+
00280      &  5*V2+5*V1)+X3*Y3*KYEL*(8*U3+5*U2+5*U1)+2*Y2**2*KXEL*(-4
00281      &  *U3-4*U2-U1)+Y2*Y3*KXEL*(8*U3+11*U2-U1)+Y3**2*KXEL*(-8*U3
00282      &  -5*U2-5*U1))*XMUL/(18*X2*Y3-18*X3*Y2)
00283 !
00284 !  USES HERE THE 'MAGIC SQUARE' PROPERTIES OF A DIFFUSION-LIKE MATRIX
00285 !  (SUM OF EACH LINE AND EACH COLUMN IS 0)
00286 !
00287       A14(IELEM) = - A11(IELEM) - A12(IELEM) - A13(IELEM)
00288       A22(IELEM) = - A21(IELEM) - A23(IELEM) - A24(IELEM)
00289       A33(IELEM) = - A31(IELEM) - A32(IELEM) - A34(IELEM)
00290       A41(IELEM) = - A11(IELEM) - A21(IELEM) - A31(IELEM)
00291       A42(IELEM) = - A12(IELEM) - A22(IELEM) - A32(IELEM)
00292       A43(IELEM) = - A13(IELEM) - A23(IELEM) - A33(IELEM)
00293       A44(IELEM) = - A14(IELEM) - A24(IELEM) - A34(IELEM)
00294 !
00295       ENDDO ! IELEM
00296 !
00297 !-----------------------------------------------------------------------
00298 ! CASE WHERE U IS OF QUASI-BUBBLE DISCRETISATION
00299 !-----------------------------------------------------------------------
00300 !
00301       ELSEIF(IELMF.EQ.10.AND.IELMG.EQ.10.AND.
00302      &       IELMU.EQ.12.AND.IELMV.EQ.12) THEN
00303 !
00304 !   LOOP ON THE ELEMENTS
00305 !
00306       DO IELEM = 1 , NELEM
00307 !
00308       X2  =   XEL(IELEM,2)
00309       X3  =   XEL(IELEM,3)
00310       Y2  =   YEL(IELEM,2)
00311       Y3  =   YEL(IELEM,3)
00312 !
00313       U1   =  U(IKLE1(IELEM))
00314       U2   =  U(IKLE2(IELEM))
00315       U3   =  U(IKLE3(IELEM))
00316       U4   =  U(IKLE3(IELEM))
00317       V1   =  V(IKLE1(IELEM))
00318       V2   =  V(IKLE2(IELEM))
00319       V3   =  V(IKLE3(IELEM))
00320       V4   =  V(IKLE3(IELEM))
00321 !
00322       KXEL =  F(IELEM)
00323       KYEL =  G(IELEM)
00324 !
00325 ! COMPUTES 9 OF THE 16 TERMS
00326 !
00327       A11(IELEM)=
00328      &  (X2**2*KYEL*(V3+5*V4+4*V2+5*V1)+4*X2*X3*KYEL*(-
00329      &  V3-2*V4-V2-2*V1)+X2*Y2*KXEL*(-V3-5*V4-4*V2-5*V1)+X2*Y2
00330      &  *KYEL*(-U3-5*U4-4*U2-5*U1)+2*X2*Y3*KXEL*(V3+2*V4+V2+2*
00331      &  V1)+2*X2*Y3*KYEL*(U3+2*U4+U2+2*U1)+X3**2*KYEL*(4*V3+5*V4
00332      &  +V2+5*V1)+2*X3*Y2*KXEL*(V3+2*V4+V2+2*V1)+2*X3*Y2*KYEL*(
00333      &  U3+2*U4+U2+2*U1)+X3*Y3*KXEL*(-4*V3-5*V4-V2-5*V1)+X3*Y3
00334      &  *KYEL*(-4*U3-5*U4-U2-5*U1)+Y2**2*KXEL*(U3+5*U4+4*U2+5*
00335      &  U1)+4*Y2*Y3*KXEL*(-U3-2*U4-U2-2*U1)+Y3**2*KXEL*(4*U3+5*
00336      &  U4+U2+5*U1))*XMUL/(18*X2*Y3-18*X3*Y2)
00337 !
00338       A12(IELEM)=
00339      &  (2*X2**2*KYEL*(V4+V2+V1)+X2*X3*KYEL*(V4+V2+V1)-(2
00340      &  *X2*Y2*KXEL)*(V4+V2+V1)-(2*X2*Y2*KYEL)*(U4+U2+U1)+X2*Y3*KXEL*(
00341      &  V4+V2+V1)-(2*X2*Y3*KYEL)*(U4+U2+U1)-(X3**2*KYEL)*(V4+V2+V1)-
00342      &  (2*X3*Y2*KXEL)*(V4+V2+V1)+X3*Y2*KYEL*(U4+U2+U1)+X3*Y3*KXEL*(V4
00343      &  +V2+V1)+X3*Y3*KYEL*(U4+U2+U1)+2*Y2**2*KXEL*(U4+U2+U1)+Y2*Y3*
00344      &  KXEL*(U4+U2+U1)-(Y3**2*KXEL)*(U4+U2+U1))
00345      &  *XMUL/(18*X2*Y3-18*X3*Y2)
00346 !
00347       A13(IELEM)=
00348      &  (-(X2**2*KYEL)*(V3+V4+V1)+X2*X3*KYEL*(V3+V4+V1)+X2*
00349      &  Y2*KXEL*(V3+V4+V1)+X2*Y2*KYEL*(U3+U4+U1)-(2*X2*Y3*KXEL)*(V3+V4
00350      &  +V1)+X2*Y3*KYEL*(U3+U4+U1)+2*X3**2*KYEL*(V3+V4+V1)+X3*Y2*KXEL*
00351      &  (V3+V4+V1)-(2*X3*Y2*KYEL)*(U3+U4+U1)-(2*X3*Y3*KXEL)*(V3+V4+
00352      &  V1)-(2*X3*Y3*KYEL)*(U3+U4+U1)-(Y2**2*KXEL)*(U3+U4+U1)+Y2*Y3*
00353      &  KXEL*(U3+U4+U1)+2*Y3**2*KXEL*(U3+U4+U1))
00354      &  *XMUL/(18*X2*Y3-18*X3*Y2)
00355 !
00356       A21(IELEM)=
00357      &  (2*X2**2*KYEL*(V4+V2+V1)+X2*X3*KYEL*(V4+V2+V1)-(2
00358      &  *X2*Y2*KXEL)*(V4+V2+V1)-(2*X2*Y2*KYEL)*(U4+U2+U1)-(2*X2*Y3*
00359      &  KXEL)*(V4+V2+V1)+X2*Y3*KYEL*(U4+U2+U1)-(X3**2*KYEL)*(V4+V2+V1)+
00360      &  X3*Y2*KXEL*(V4+V2+V1)-(2*X3*Y2*KYEL)*(U4+U2+U1)+X3*Y3*KXEL*(V4
00361      &  +V2+V1)+X3*Y3*KYEL*(U4+U2+U1)+2*Y2**2*KXEL*(U4+U2+U1)+Y2*Y3*
00362      &  KXEL*(U4+U2+U1)-(Y3**2*KXEL)*(U4+U2+U1))
00363      &  *XMUL/(18*X2*Y3-18*X3*Y2)
00364 !
00365       A23(IELEM)=
00366      &  (2*X2**2*KYEL*(V3+V4+V2)-(5*X2*X3*KYEL)*(V3+V4+V2
00367      &  )-(2*X2*Y2*KXEL)*(V3+V4+V2)-(2*X2*Y2*KYEL)*(U3+U4+U2)+4*X2
00368      &  *Y3*KXEL*(V3+V4+V2)+X2*Y3*KYEL*(U3+U4+U2)+2*X3**2*KYEL*(V3+V4+
00369      &  V2)+X3*Y2*KXEL*(V3+V4+V2)+4*X3*Y2*KYEL*(U3+U4+U2)-(2*X3*Y3*
00370      &  KXEL)*(V3+V4+V2)-(2*X3*Y3*KYEL)*(U3+U4+U2)+2*Y2**2*KXEL*(U3+
00371      &  U4+U2)-(5*Y2*Y3*KXEL)*(U3+U4+U2)+2*Y3**2*KXEL*(U3+U4+U2))
00372      &  *XMUL/(18*X2*Y3-18*X3*Y2)
00373 !
00374       A24(IELEM)=
00375      &  (X2**2*KYEL*(-V3-2*V4-2*V2-V1)+X2*X3*KYEL*(3*V3+
00376      &  2*V4+2*V2-V1)+X2*Y2*KXEL*(V3+2*V4+2*V2+V1)+X2*Y2*KYEL*(U3+
00377      &  2*U4+2*U2+U1)+X2*Y3*KXEL*(-2*V3-V4-V2+V1)-(X2*Y3*KYEL)*(U3+
00378      &  U4+U2)-(2*X3**2*KYEL)*(V3+V4+V2)-(X3*Y2*KXEL)*(V3+V4+V2)+X3*
00379      &  Y2*KYEL*(-2*U3-U4-U2+U1)+2*X3*Y3*KXEL*(V3+V4+V2)+2*X3*Y3*
00380      &  KYEL*(U3+U4+U2)+Y2**2*KXEL*(-U3-2*U4-2*U2-U1)+Y2*Y3*KXEL*(3*
00381      &  U3+2*U4+2*U2-U1)-(2*Y3**2*KXEL)*(U3+U4+U2))
00382      &  *XMUL/(6*X2*Y3-6*X3*Y2)
00383 !
00384       A31(IELEM)=
00385      &  (-(X2**2*KYEL)*(V3+V4+V1)+X2*X3*KYEL*(V3+V4+V1)+X2*
00386      &  Y2*KXEL*(V3+V4+V1)+X2*Y2*KYEL*(U3+U4+U1)+X2*Y3*KXEL*(V3+V4+V1)-
00387      &  (2*X2*Y3*KYEL)*(U3+U4+U1)+2*X3**2*KYEL*(V3+V4+V1)-(2*X3*Y2
00388      &  *KXEL)*(V3+V4+V1)+X3*Y2*KYEL*(U3+U4+U1)-(2*X3*Y3*KXEL)*(V3+V4+
00389      &  V1)-(2*X3*Y3*KYEL)*(U3+U4+U1)-(Y2**2*KXEL)*(U3+U4+U1)+Y2*Y3*
00390      &  KXEL*(U3+U4+U1)+2*Y3**2*KXEL*(U3+U4+U1))
00391      &  *XMUL/(18*X2*Y3-18*X3*Y2)
00392 !
00393       A32(IELEM)=
00394      &  (2*X2**2*KYEL*(V3+V4+V2)-(5*X2*X3*KYEL)*(V3+V4+V2
00395      &  )-(2*X2*Y2*KXEL)*(V3+V4+V2)-(2*X2*Y2*KYEL)*(U3+U4+U2)+X2*Y3
00396      &  *KXEL*(V3+V4+V2)+4*X2*Y3*KYEL*(U3+U4+U2)+2*X3**2*KYEL*(V3+V4+
00397      &  V2)+4*X3*Y2*KXEL*(V3+V4+V2)+X3*Y2*KYEL*(U3+U4+U2)-(2*X3*Y3*
00398      &  KXEL)*(V3+V4+V2)-(2*X3*Y3*KYEL)*(U3+U4+U2)+2*Y2**2*KXEL*(U3+
00399      &  U4+U2)-(5*Y2*Y3*KXEL)*(U3+U4+U2)+2*Y3**2*KXEL*(U3+U4+U2))
00400      &  *XMUL/(18*X2*Y3-18*X3*Y2)
00401 !
00402       A34(IELEM)=
00403      &  (-(2*X2**2*KYEL)*(V3+V4+V2)+X2*X3*KYEL*(2*V3+2*
00404      &  V4+3*V2-V1)+2*X2*Y2*KXEL*(V3+V4+V2)+2*X2*Y2*KYEL*(U3+U4+U2
00405      &  )-(X2*Y3*KXEL)*(V3+V4+V2)+X2*Y3*KYEL*(-U3-U4-2*U2+U1)+X3**2*
00406      &  KYEL*(-2*V3-2*V4-V2-V1)+X3*Y2*KXEL*(-V3-V4-2*V2+V1)-(X3*Y2
00407      &  *KYEL)*(U3+U4+U2)+X3*Y3*KXEL*(2*V3+2*V4+V2+V1)+X3*Y3*KYEL*(2
00408      &  *U3+2*U4+U2+U1)-(2*Y2**2*KXEL)*(U3+U4+U2)+Y2*Y3*KXEL*(2*U3
00409      &  +2*U4+3*U2-U1)+Y3**2*KXEL*(-2*U3-2*U4-U2-U1))
00410      &  *XMUL/(6*X2*Y3-6*X3*Y2)
00411 !
00412 !
00413 !  USES HERE THE 'MAGIC SQUARE' PROPERTIES OF A DIFFUSION-LIKE MATRIX
00414 !  (SUM OF EACH LINE AND EACH COLUMN IS 0)
00415 !
00416       A14(IELEM) = - A11(IELEM) - A12(IELEM) - A13(IELEM)
00417       A22(IELEM) = - A21(IELEM) - A23(IELEM) - A24(IELEM)
00418       A33(IELEM) = - A31(IELEM) - A32(IELEM) - A34(IELEM)
00419       A41(IELEM) = - A11(IELEM) - A21(IELEM) - A31(IELEM)
00420       A42(IELEM) = - A12(IELEM) - A22(IELEM) - A32(IELEM)
00421       A43(IELEM) = - A13(IELEM) - A23(IELEM) - A33(IELEM)
00422       A44(IELEM) = - A14(IELEM) - A24(IELEM) - A34(IELEM)
00423 !
00424       ENDDO ! IELEM
00425 !
00426 !     OTHER TYPES OF FUNCTIONS F AND G
00427 !
00428 !-----------------------------------------------------------------------
00429 !
00430       ELSE
00431 !
00432         IF (LNG.EQ.1) WRITE(LU,100) IELMF,SF%NAME
00433         IF (LNG.EQ.1) WRITE(LU,110) IELMG,SG%NAME
00434         IF (LNG.EQ.1) WRITE(LU,200) IELMU,SU%NAME
00435         IF (LNG.EQ.1) WRITE(LU,300)
00436         IF (LNG.EQ.1) WRITE(LU,101) IELMF,SF%NAME
00437         IF (LNG.EQ.1) WRITE(LU,111) IELMG,SG%NAME
00438         IF (LNG.EQ.1) WRITE(LU,201) IELMU,SU%NAME
00439         IF (LNG.EQ.1) WRITE(LU,301)
00440 100     FORMAT(1X,'MT03BB (BIEF) :',/,
00441      &         1X,'DISCRETISATION DE F : ',1I6,
00442      &         1X,'NOM REEL : ',A6)
00443 110     FORMAT(1X,'DISCRETISATION DE G : ',1I6,
00444      &         1X,'NOM REEL : ',A6)
00445 200     FORMAT(1X,'DISCRETISATION DE U : ',1I6,
00446      &         1X,'NOM REEL : ',A6)
00447 300     FORMAT(1X,'CAS NON PREVU')
00448 101     FORMAT(1X,'MT03BB (BIEF) :',/,
00449      &         1X,'DISCRETIZATION OF F:',1I6,
00450      &         1X,'REAL NAME: ',A6)
00451 111     FORMAT(1X,'DISCRETIZATION OF G:',1I6,
00452      &         1X,'REAL NAME: ',A6)
00453 201     FORMAT(1X,'DISCRETIZATION OF U:',1I6,
00454      &         1X,'REAL NAME: ',A6)
00455 301     FORMAT(1X,'CASE NOT IMPLEMENTED')
00456         CALL PLANTE(0)
00457         STOP
00458 !
00459       ENDIF
00460 !
00461 !-----------------------------------------------------------------------
00462 !
00463       RETURN
00464       END

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