mt02bb.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mt02bb.f
00002 !
00062                      SUBROUTINE MT02BB
00063 !                    *****************
00064 !
00065      &( A11 , A12 , A13 , A14 ,
00066      &        A22 , A23 , A24 ,
00067      &              A33 , A34 ,
00068      &                    A44 ,
00069      &  XMUL,SU,U,XEL,YEL,SURFAC,IKLE1,IKLE2,IKLE3,NELEM,NELMAX)
00070 !
00071 !***********************************************************************
00072 ! BIEF   V6P1                                   21/08/2010
00073 !***********************************************************************
00074 !
00075 !
00076 !
00077 !
00078 !
00079 !
00080 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00081 !| A11            |<--| ELEMENTS OF MATRIX
00082 !| A12            |<--| ELEMENTS OF MATRIX
00083 !| A13            |<--| ELEMENTS OF MATRIX
00084 !| A14            |<--| ELEMENTS OF MATRIX
00085 !| A22            |<--| ELEMENTS OF MATRIX
00086 !| A23            |<--| ELEMENTS OF MATRIX
00087 !| A24            |<--| ELEMENTS OF MATRIX
00088 !| A33            |<--| ELEMENTS OF MATRIX
00089 !| A34            |<--| ELEMENTS OF MATRIX
00090 !| A44            |<--| ELEMENTS OF MATRIX
00091 !| IKLE1          |-->| FIRST POINTS OF TRIANGLES
00092 !| IKLE2          |-->| SECOND POINTS OF TRIANGLES
00093 !| IKLE3          |-->| THIRD POINTS OF TRIANGLES
00094 !| NELEM          |-->| NUMBER OF ELEMENTS
00095 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00096 !| SU             |-->| BIEF_OBJ STRUCTURE OF U
00097 !| SURFAC         |-->| AREA OF TRIANGLES
00098 !| U              |-->| FUNCTION U USED IN THE FORMULA
00099 !| XEL            |-->| ABSCISSAE OF POINTS IN THE MESH, PER ELEMENT
00100 !| YEL            |-->| ORDINATES OF POINTS IN THE MESH, PER ELEMENT
00101 !| XMUL           |-->| MULTIPLICATION FACTOR
00102 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00103 !
00104       USE BIEF, EX_MT02BB => MT02BB
00105 !
00106       IMPLICIT NONE
00107       INTEGER LNG,LU
00108       COMMON/INFO/LNG,LU
00109 !
00110 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00111 !
00112       INTEGER, INTENT(IN) :: NELEM,NELMAX
00113       INTEGER, INTENT(IN) :: IKLE1(NELMAX),IKLE2(NELMAX),IKLE3(NELMAX)
00114       DOUBLE PRECISION, INTENT(INOUT) :: A11(*),A12(*),A13(*),A14(*)
00115       DOUBLE PRECISION, INTENT(INOUT) ::        A22(*),A23(*),A24(*)
00116       DOUBLE PRECISION, INTENT(INOUT) ::               A33(*),A34(*)
00117       DOUBLE PRECISION, INTENT(INOUT) ::                      A44(*)
00118       DOUBLE PRECISION, INTENT(IN)    :: XMUL,U(*)
00119 !     STRUCTURE OF U
00120       TYPE(BIEF_OBJ), INTENT(IN)      :: SU
00121 !
00122       DOUBLE PRECISION, INTENT(IN)    :: XEL(NELMAX,3),YEL(NELMAX,3)
00123       DOUBLE PRECISION, INTENT(IN)    :: SURFAC(NELMAX)
00124 !
00125 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00126 !
00127 !     DECLARATIONS SPECIFIC TO THIS SUBROUTINE
00128 !
00129       INTEGER IELMNU,IELEM,ISO,IAD2,IAD3
00130 !
00131       DOUBLE PRECISION X2,X3,Y2,Y3,AUX1,AUX2
00132       DOUBLE PRECISION NUX1,NUX2,NUX3,NUY1,NUY2,NUY3,NUZ1,NUZ2,NUZ3
00133 !
00134 !=======================================================================
00135 !
00136 !     EXTRACTS THE TYPE OF ELEMENT FOR VISCOSITY
00137 !
00138       IELMNU = SU%ELM
00139       ISO = SU%DIM2
00140 !
00141 !     IF(IELMNU.EQ.10.AND.ISO.EQ.1) THEN
00142 !
00143 !-----------------------------------------------------------------------
00144 !
00145 !  P0 DISCRETISATION FOR VISCOSITY:
00146 !
00147 !-----------------------------------------------------------------------
00148 !
00149       IF(IELMNU.EQ.11.AND.ISO.EQ.1) THEN
00150 !
00151 !-----------------------------------------------------------------------
00152 !
00153 !  P1 DISCRETISATION FOR ISOTROPIC VISCOSITY:
00154 !
00155       DO IELEM = 1 , NELEM
00156 !
00157 !   INITIALISES THE GEOMETRICAL VARIABLES
00158 !
00159         X2  =  XEL(IELEM,2)
00160         X3  =  XEL(IELEM,3)
00161 !
00162         Y2  =  YEL(IELEM,2)
00163         Y3  =  YEL(IELEM,3)
00164 !
00165         NUX1 = U(IKLE1(IELEM))
00166         NUX2 = U(IKLE2(IELEM))
00167         NUX3 = U(IKLE3(IELEM))
00168 !
00169         AUX1 = XMUL/(108*SURFAC(IELEM))
00170         AUX2 = 3 * AUX1
00171 !
00172 !  EXTRADIAGONAL TERMS
00173 !  SOME FACTORISATIONS REMAIN TO BE DONE
00174 !
00175         A12(IELEM)=((2*X2**2+X2*X3-X3**2-Y3**2+Y3*Y2+2*Y2**2)*(
00176      &   NUX3+4*NUX2+4*NUX1))*AUX1
00177 !
00178         A13(IELEM)=(-(X2**2-X2*X3-2*X3**2-2*Y3**2-Y3*Y2+Y2**2)*(
00179      &   4*NUX3+NUX2+4*NUX1))*AUX1
00180 !
00181         A14(IELEM)=((4*NUX3+NUX2+4*NUX1)*X2*X3-2*(4*NUX3+NUX2+
00182      &   4*NUX1)*X3**2-2*(4*NUX3+NUX2+4*NUX1)*Y3**2+(4*NUX3+
00183      &   NUX2+4*NUX1)*Y3*Y2-2*(NUX3+4*NUX2+4*NUX1)*X2**2+(NUX3
00184      &   +4*NUX2+4*NUX1)*X2*X3+(NUX3+4*NUX2+4*NUX1)*Y3*Y2-2*(
00185      &   NUX3+4*NUX2+4*NUX1)*Y2**2)*AUX2
00186 !
00187         A23(IELEM)=((2*X2**2-5*X2*X3+2*X3**2+2*Y3**2-5*Y3*Y2+
00188      &   2*Y2**2)*(4*NUX3+4*NUX2+NUX1))*AUX1
00189 !
00190         A24(IELEM)=(-((4*NUX3+4*NUX2+NUX1)*X2**2-3*(4*NUX3+4*
00191      &   NUX2+NUX1)*X2*X3+2*(4*NUX3+4*NUX2+NUX1)*X3**2+2*(4*
00192      &   NUX3+4*NUX2+NUX1)*Y3**2-3*(4*NUX3+4*NUX2+NUX1)*Y3*Y2+
00193      &   (4*NUX3+4*NUX2+NUX1)*Y2**2+(NUX3+4*NUX2+4*NUX1)*X2**2
00194      &   +(NUX3+4*NUX2+4*NUX1)*X2*X3+(NUX3+4*NUX2+4*NUX1)*Y3*
00195      &    Y2+(NUX3+4*NUX2+4*NUX1)*Y2**2))*AUX2
00196 !
00197         A34(IELEM)=(
00198      &     NUX1*(-5*Y3**2-Y3*Y2-2*Y2**2)+NUX2*(-5*Y3**
00199      &    2+11*Y3*Y2-8*Y2**2)+8*NUX3*(-Y3**2+Y3*Y2-Y2**2)+NUX1*(
00200      &    -2*X2**2-X2*X3-5*X3**2)+NUX2*(-8*X2**2+11*X2*X3-5*X3
00201      &    **2)+8*NUX3*(-X2**2+X2*X3-X3**2))*AUX2
00202 !
00203 !   THE DIAGONAL TERMS ARE OBTAINED BY MEANS OF THE
00204 !   MAGIC SQUARE:
00205 !
00206         A11(IELEM) = - A12(IELEM) - A13(IELEM) - A14(IELEM)
00207         A22(IELEM) = - A12(IELEM) - A23(IELEM) - A24(IELEM)
00208         A33(IELEM) = - A13(IELEM) - A23(IELEM) - A34(IELEM)
00209         A44(IELEM) = - A14(IELEM) - A24(IELEM) - A34(IELEM)
00210 !
00211       ENDDO ! IELEM
00212 !
00213 !-----------------------------------------------------------------------
00214 !
00215       ELSEIF(IELMNU.EQ.11.AND.ISO.EQ.3) THEN
00216 !
00217 !-----------------------------------------------------------------------
00218 !
00219 !  P1 DISCRETISATION FOR NONISOTROPIC VISCOSITY:
00220 !
00221       IAD2 = SU%MAXDIM1
00222       IAD3 = 2*IAD2
00223       DO IELEM = 1 , NELEM
00224 !
00225 !   INITIALISES THE GEOMETRICAL VARIABLES
00226 !
00227         X2  =  XEL(IELEM,2)
00228         X3  =  XEL(IELEM,3)
00229 !
00230         Y2  =  YEL(IELEM,2)
00231         Y3  =  YEL(IELEM,3)
00232 !
00233         NUX1 = U(IKLE1(IELEM))
00234         NUX2 = U(IKLE2(IELEM))
00235         NUX3 = U(IKLE3(IELEM))
00236         NUY1 = U(IKLE1(IELEM)+IAD2)
00237         NUY2 = U(IKLE2(IELEM)+IAD2)
00238         NUY3 = U(IKLE3(IELEM)+IAD2)
00239         NUZ1 = U(IKLE1(IELEM)+IAD3)
00240         NUZ2 = U(IKLE2(IELEM)+IAD3)
00241         NUZ3 = U(IKLE3(IELEM)+IAD3)
00242 !
00243         AUX1 = XMUL/(108*SURFAC(IELEM))
00244         AUX2 = 3 * AUX1
00245 !
00246 !  EXTRADIAGONAL TERMS
00247 !
00248         A12(IELEM)=(-4*NUX1*(Y3+Y2)*(Y3-2*Y2)-4*NUX2*(Y3+Y2)*(
00249      &   Y3-2*Y2)-NUX3*(Y3+Y2)*(Y3-2*Y2)+((NUY3+4*NUY2+4*NUY1)
00250      &   *X3-(Y3+4*Y2)*NUZ3-4*(Y3+4*Y2)*NUZ2-4*(Y3+4*Y2)*NUZ1
00251      &   )*X2+(NUZ3+4*NUZ2+4*NUZ1)*(2*Y3-Y2)*X3+2*(NUY3+4*
00252      &   NUY2+4*NUY1)*X2**2-(NUY3+4*NUY2+4*NUY1)*X3**2)*AUX1
00253 !
00254         A13(IELEM)=(4*NUX1*(2*Y3-Y2)*(Y3+Y2)+NUX2*(2*Y3-Y2)*(Y3
00255      &   +Y2)+4*NUX3*(2*Y3-Y2)*(Y3+Y2)+((4*NUY3+NUY2+4*NUY1)*
00256      &   X3-4*(Y3-2*Y2)*NUZ3-(Y3-2*Y2)*NUZ2-4*(Y3-2*Y2)*NUZ1)
00257      &   *X2-(4*NUZ3+NUZ2+4*NUZ1)*(4*Y3+Y2)*X3-(4*NUY3+NUY2+4
00258      &   *NUY1)*X2**2+2*(4*NUY3+NUY2+4*NUY1)*X3**2)*AUX1
00259 !
00260         A14(IELEM)=(4*NUX1*(-(2*Y3-Y2)*Y3+(Y3-2*Y2)*Y2)+NUX2*(-
00261      &   (2*Y3-Y2)*Y3+4*(Y3-2*Y2)*Y2)+NUX3*(-4*(2*Y3-Y2)*Y3+(
00262      &   Y3-2*Y2)*Y2)+((4*NUY3+NUY2+4*NUY1)*X3-4*NUZ3*Y3-NUZ2*
00263      &   Y3-4*NUZ1*Y3)*X2+((NUY3+4*NUY2+4*NUY1)*X3-(Y3-4*Y2)*
00264      &   NUZ3-4*(Y3-4*Y2)*NUZ2-4*(Y3-4*Y2)*NUZ1)*X2+(4*NUZ3+
00265      &   NUZ2+4*NUZ1)*(4*Y3-Y2)*X3-(NUZ3+4*NUZ2+4*NUZ1)*X3*Y2-
00266      &  2*(4*NUY3+NUY2+4*NUY1)*X3**2-2*(NUY3+4*NUY2+4*NUY1)*X2**2)*AUX2
00267 !
00268         A23(IELEM)=(-((5*(4*NUY3+4*NUY2+NUY1)*X3-4*(5*Y3-4*
00269      &   Y2)*NUZ3-4*(5*Y3-4*Y2)*NUZ2-(5*Y3-4*Y2)*NUZ1)*X2+(4
00270      &   *NUZ3+4*NUZ2+NUZ1)*(4*Y3-5*Y2)*X3-2*(4*NUY3+4*NUY2+
00271      &   NUY1)*X2**2-2*(4*NUY3+4*NUY2+NUY1)*X3**2-4*(2*Y3-Y2)
00272      &   *(Y3-2*Y2)*NUX3-4*(2*Y3-Y2)*(Y3-2*Y2)*NUX2-(2*Y3-Y2)
00273      &   *(Y3-2*Y2)*NUX1))*AUX1
00274 !
00275         A24(IELEM)=(-(5*X2**2*NUY3+8*X2**2*NUY2+5*X2**2*NUY1-
00276      &   11*X2*X3*NUY3-8*X2*X3*NUY2+X2*X3*NUY1+11*X2*NUZ3*Y3-10
00277      &   *X2*NUZ3*Y2+8*X2*NUZ2*Y3-16*X2*NUZ2*Y2-X2*NUZ1*Y3-10*
00278      &   X2*NUZ1*Y2+8*X3**2*NUY3+8*X3**2*NUY2+2*X3**2*NUY1-16*
00279      &   X3*NUZ3*Y3+11*X3*NUZ3*Y2-16*X3*NUZ2*Y3+8*X3*NUZ2*Y2-4
00280      &   *X3*NUZ1*Y3-X3*NUZ1*Y2+8*NUX3*Y3**2-11*NUX3*Y3*Y2+5*
00281      &   NUX3*Y2**2+8*NUX2*Y3**2-8*NUX2*Y3*Y2+8*NUX2*Y2**2+2*
00282      &   NUX1*Y3**2+NUX1*Y3*Y2+5*NUX1*Y2**2))*AUX2
00283 !
00284         A34(IELEM)=(-(8*X2**2*NUY3+8*X2**2*NUY2+2*X2**2*NUY1-8
00285      &   *X2*X3*NUY3-11*X2*X3*NUY2+X2*X3*NUY1+8*X2*NUZ3*Y3-16*
00286      &   X2*NUZ3*Y2+11*X2*NUZ2*Y3-16*X2*NUZ2*Y2-X2*NUZ1*Y3-4*X2
00287      &   *NUZ1*Y2+8*X3**2*NUY3+5*X3**2*NUY2+5*X3**2*NUY1-16*X3
00288      &   *NUZ3*Y3+8*X3*NUZ3*Y2-10*X3*NUZ2*Y3+11*X3*NUZ2*Y2-10*
00289      &   X3*NUZ1*Y3-X3*NUZ1*Y2+8*NUX3*Y3**2-8*NUX3*Y3*Y2+8*NUX3
00290      &   *Y2**2+5*NUX2*Y3**2-11*NUX2*Y3*Y2+8*NUX2*Y2**2+5*NUX1
00291      &   *Y3**2+NUX1*Y3*Y2+2*NUX1*Y2**2))*AUX2
00292 !
00293 !   THE DIAGONAL TERMS ARE OBTAINED BY MEANS OF THE
00294 !   MAGIC SQUARE:
00295 !
00296         A11(IELEM) = - A12(IELEM) - A13(IELEM) - A14(IELEM)
00297         A22(IELEM) = - A12(IELEM) - A23(IELEM) - A24(IELEM)
00298         A33(IELEM) = - A13(IELEM) - A23(IELEM) - A34(IELEM)
00299         A44(IELEM) = - A14(IELEM) - A24(IELEM) - A34(IELEM)
00300 !
00301       ENDDO ! IELEM
00302 !
00303 !-----------------------------------------------------------------------
00304 !
00305       ELSE
00306 !
00307         IF (LNG.EQ.1) WRITE(LU,10) IELMNU,ISO
00308         IF (LNG.EQ.2) WRITE(LU,11) IELMNU,ISO
00309 10      FORMAT(1X,'MT02BB (BIEF) : TYPE DE VISCOSITE NON PREVU : ',2I6)
00310 11      FORMAT(1X,
00311      &  'MT02BB (BIEF) : TYPE OF VISCOSITY NOT AVAILABLE : ',2I6)
00312         CALL PLANTE(0)
00313         STOP
00314 !
00315       ENDIF
00316 !
00317 !-----------------------------------------------------------------------
00318 !
00319       RETURN
00320       END

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