mt08ab.f

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

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