mt12aa.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mt12aa.f
00002 !
00084                      SUBROUTINE MT12AA
00085 !                    *****************
00086 !
00087      &(  A11 , A12 , A13 ,
00088      &   A21 , A22 , A23 ,
00089      &   A31 , A32 , A33 ,
00090      &   XMUL,SF,SU,SV,F,U,V,
00091      &   XEL,YEL,SURDET,
00092      &   IKLE1,IKLE2,IKLE3,
00093      &   NELEM,NELMAX,ICOORD)
00094 !
00095 !***********************************************************************
00096 ! BIEF   V6P2                                   21/08/2010
00097 !***********************************************************************
00098 !
00099 !
00100 !
00101 !
00102 !
00103 !
00104 !
00105 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00106 !| A11            |<--| ELEMENTS OF MATRIX
00107 !| A12            |<--| ELEMENTS OF MATRIX
00108 !| A13            |<--| ELEMENTS OF MATRIX
00109 !| A21            |<--| ELEMENTS OF MATRIX
00110 !| A22            |<--| ELEMENTS OF MATRIX
00111 !| A23            |<--| ELEMENTS OF MATRIX
00112 !| A31            |<--| ELEMENTS OF MATRIX
00113 !| A32            |<--| ELEMENTS OF MATRIX
00114 !| A33            |<--| ELEMENTS OF MATRIX
00115 !| F              |-->| FUNCTION USED IN THE FORMULA
00116 !| ICOORD         |-->| 1: DERIVATIVE ALONG X, 2: ALONG Y
00117 !| IKLE1          |-->| FIRST POINTS OF TRIANGLES
00118 !| IKLE2          |-->| SECOND POINTS OF TRIANGLES
00119 !| IKLE3          |-->| THIRD POINTS OF TRIANGLES
00120 !| IKLE4          |-->| QUASI-BUBBLE POINT
00121 !| NELEM          |-->| NUMBER OF ELEMENTS
00122 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00123 !| SF             |-->| STRUCTURE OF FUNCTIONS F
00124 !| SU             |-->| BIEF_OBJ STRUCTURE OF U
00125 !| SURDET         |-->| HERE = 1/(2*SURFAC)
00126 !| SV             |-->| BIEF_OBJ STRUCTURE OF V
00127 !| U              |-->| FUNCTION U USED IN THE FORMULA
00128 !| V              |-->| FUNCTION V USED IN THE FORMULA
00129 !| XEL            |-->| ABSCISSAE OF POINTS IN THE MESH, PER ELEMENT
00130 !| YEL            |-->| ORDINATES OF POINTS IN THE MESH, PER ELEMENT
00131 !| XMUL           |-->| MULTIPLICATION FACTOR
00132 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00133 !
00134       USE BIEF, EX_MT12AA => MT12AA
00135 !
00136       IMPLICIT NONE
00137       INTEGER LNG,LU
00138       COMMON/INFO/LNG,LU
00139 !
00140 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00141 !
00142       INTEGER, INTENT(IN) :: NELEM,NELMAX,ICOORD
00143       INTEGER, INTENT(IN) :: IKLE1(NELMAX),IKLE2(NELMAX),IKLE3(NELMAX)
00144 !
00145       DOUBLE PRECISION, INTENT(INOUT) :: A11(*),A12(*),A13(*)
00146       DOUBLE PRECISION, INTENT(INOUT) :: A21(*),A22(*),A23(*)
00147       DOUBLE PRECISION, INTENT(INOUT) :: A31(*),A32(*),A33(*)
00148 !
00149       DOUBLE PRECISION, INTENT(IN) :: XMUL
00150       DOUBLE PRECISION, INTENT(IN) :: F(*),U(*),V(*)
00151 !
00152 !     STRUCTURES OF F, U, V
00153       TYPE(BIEF_OBJ), INTENT(IN) :: SF,SU,SV
00154 !
00155       DOUBLE PRECISION, INTENT(IN) :: XEL(NELMAX,3),YEL(NELMAX,3)
00156       DOUBLE PRECISION, INTENT(IN) :: SURDET(NELMAX)
00157 !
00158 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00159 !
00160       INTEGER IELEM,IELMF,IELMU,IELMV
00161       DOUBLE PRECISION X2,X3,Y2,Y3,F1,F2,F3,DEN
00162       DOUBLE PRECISION U1,U2,U3,V1,V2,V3,U123,V123,XSUR06,XSUR24
00163 !
00164 !-----------------------------------------------------------------------
00165 !
00166       XSUR06 = XMUL/06.D0
00167       XSUR24 = XMUL/24.D0
00168 !
00169 !-----------------------------------------------------------------------
00170 !
00171       IELMF=SF%ELM
00172       IELMU=SU%ELM
00173       IELMV=SV%ELM
00174 !
00175 !  CASE WHERE F IS OF TYPE P1 AND U P0
00176 !
00177       IF(IELMF.EQ.11.AND.IELMU.EQ.10.AND.IELMV.EQ.10) THEN
00178 !
00179 !================================
00180 !  DERIVATIVE WRT X  =
00181 !================================
00182 !
00183       IF(ICOORD.EQ.1) THEN
00184 !
00185 !   LOOP ON THE ELEMENTS
00186 !
00187       DO IELEM = 1 , NELEM
00188 !
00189 !   INITIALISES THE GEOMETRICAL VARIABLES
00190 !
00191       X2 = XEL(IELEM,2)
00192       X3 = XEL(IELEM,3)
00193       Y2 = YEL(IELEM,2)
00194       Y3 = YEL(IELEM,3)
00195 !
00196       F1  =  F(IKLE1(IELEM))
00197       F2  =  F(IKLE2(IELEM)) - F1
00198       F3  =  F(IKLE3(IELEM)) - F1
00199 !
00200       DEN = (F3*Y2 - F2*Y3) * XSUR06 * SURDET(IELEM)
00201 !
00202 !   EXTRADIAGONAL TERMS
00203 !
00204       A23(IELEM) = (  X3 *V(IELEM) -  Y3    *U(IELEM) )*DEN
00205       A31(IELEM) =-(  X2 *V(IELEM) -     Y2 *U(IELEM) )*DEN
00206 !
00207       A12(IELEM) = - A23(IELEM) - A31(IELEM)
00208       A13(IELEM) =   A12(IELEM)
00209       A21(IELEM) =   A23(IELEM)
00210       A32(IELEM) =   A31(IELEM)
00211 !
00212 ! DIAGONAL TERMS (THE SUM OF EACH COLUMN IS 0)
00213 !
00214       A11(IELEM) = - A21(IELEM) - A31(IELEM)
00215       A22(IELEM) = - A12(IELEM) - A32(IELEM)
00216       A33(IELEM) = - A13(IELEM) - A23(IELEM)
00217 !
00218       ENDDO ! IELEM
00219 !
00220       ELSEIF(ICOORD.EQ.2) THEN
00221 !
00222 !================================
00223 !  DERIVATIVE WRT Y  =
00224 !================================
00225 !
00226       DO IELEM = 1 , NELEM
00227 !
00228 !   INITIALISES THE GEOMETRICAL VARIABLES
00229 !
00230       X2  =  XEL(IELEM,2)
00231       X3  =  XEL(IELEM,3)
00232       Y2  =  YEL(IELEM,2)
00233       Y3  =  YEL(IELEM,3)
00234 !
00235       F1  =  F(IKLE1(IELEM))
00236       F2  =  F(IKLE2(IELEM)) - F1
00237       F3  =  F(IKLE3(IELEM)) - F1
00238 !
00239       DEN = (F3*X2 - F2*X3) * XSUR06 * SURDET(IELEM)
00240 !
00241 !   EXTRADIAGONAL TERMS
00242 !
00243       A23(IELEM) = -( X3*V(IELEM) - Y3*U(IELEM) ) * DEN
00244       A31(IELEM) =  ( X2*V(IELEM) - Y2*U(IELEM) ) * DEN
00245 !
00246       A12(IELEM) = - A23(IELEM) - A31(IELEM)
00247       A13(IELEM) =   A12(IELEM)
00248       A21(IELEM) =   A23(IELEM)
00249       A32(IELEM) =   A31(IELEM)
00250 !
00251 ! DIAGONAL TERMS (THE SUM OF EACH COLUMN IS 0)
00252 !
00253       A11(IELEM) = - A21(IELEM) - A31(IELEM)
00254       A22(IELEM) = - A12(IELEM) - A32(IELEM)
00255       A33(IELEM) = - A13(IELEM) - A23(IELEM)
00256 !
00257       ENDDO ! IELEM
00258 !
00259         ELSE
00260 !
00261           IF (LNG.EQ.1) WRITE(LU,200) ICOORD
00262           IF (LNG.EQ.2) WRITE(LU,201) ICOORD
00263 200       FORMAT(1X,'MT12AA (BIEF) : COMPOSANTE IMPOSSIBLE ',
00264      &              1I6,' VERIFIER ICOORD')
00265 201       FORMAT(1X,'MT12AA (BIEF) : IMPOSSIBLE COMPONENT ',
00266      &              1I6,' CHECK ICOORD')
00267           CALL PLANTE(0)
00268           STOP
00269 !
00270         ENDIF
00271 !
00272 !-----------------------------------------------------------------------
00273 !
00274       ELSEIF(IELMF.EQ.11.AND.IELMU.EQ.11) THEN
00275 !
00276 !================================
00277 !  DERIVATIVE WRT X  =
00278 !================================
00279 !
00280       IF(ICOORD.EQ.1) THEN
00281 !
00282 !   LOOP ON THE ELEMENTS
00283 !
00284       DO IELEM = 1 , NELEM
00285 !
00286 !   INITIALISES THE GEOMETRICAL VARIABLES
00287 !
00288       X2 = XEL(IELEM,2)
00289       X3 = XEL(IELEM,3)
00290       Y2 = YEL(IELEM,2)
00291       Y3 = YEL(IELEM,3)
00292 !
00293       F1  =  F(IKLE1(IELEM))
00294       F2  =  F(IKLE2(IELEM)) - F1
00295       F3  =  F(IKLE3(IELEM)) - F1
00296 !
00297       U1  =  U(IKLE1(IELEM))
00298       U2  =  U(IKLE2(IELEM))
00299       U3  =  U(IKLE3(IELEM))
00300 !
00301       V1  =  V(IKLE1(IELEM))
00302       V2  =  V(IKLE2(IELEM))
00303       V3  =  V(IKLE3(IELEM))
00304 !
00305       U123 = U1 + U2 + U3
00306       V123 = V1 + V2 + V3
00307 !
00308       DEN = (F3*Y2 - F2*Y3) * XSUR24 * SURDET(IELEM)
00309 !
00310 !   EXTRADIAGONAL TERMS
00311 !
00312       A12(IELEM) = ( (X2-X3)*(V123+V2) + (Y3-Y2)*(U123+U2) )*DEN
00313 !
00314       A13(IELEM) = ( (X2-X3)*(V123+V3) + (Y3-Y2)*(U123+U3) )*DEN
00315 !
00316       A23(IELEM) = ( X3*(V123+V3) - Y3*(U123+U3) )*DEN
00317 !
00318       A21(IELEM) = ( X3*(V123+V1) - Y3*(U123+U1) )*DEN
00319 !
00320       A31(IELEM) =-( X2*(V123+V1) - Y2*(U123+U1) )*DEN
00321 !
00322       A32(IELEM) =-( X2*(V123+V2) - Y2*(U123+U2) )*DEN
00323 !
00324 ! DIAGONAL TERMS (THE SUM OF EACH COLUMN IS 0)
00325 !
00326       A11(IELEM) = - A21(IELEM) - A31(IELEM)
00327       A22(IELEM) = - A12(IELEM) - A32(IELEM)
00328       A33(IELEM) = - A13(IELEM) - A23(IELEM)
00329 !
00330       ENDDO ! IELEM
00331 !
00332       ELSEIF(ICOORD.EQ.2) THEN
00333 !
00334 !================================
00335 !  DERIVATIVE WRT Y  =
00336 !================================
00337 !
00338       DO IELEM = 1 , NELEM
00339 !
00340 !   INITIALISES THE GEOMETRICAL VARIABLES
00341 !
00342       X2  =  XEL(IELEM,2)
00343       X3  =  XEL(IELEM,3)
00344       Y2  =  YEL(IELEM,2)
00345       Y3  =  YEL(IELEM,3)
00346 !
00347       F1  =  F(IKLE1(IELEM))
00348       F2  =  F(IKLE2(IELEM)) - F1
00349       F3  =  F(IKLE3(IELEM)) - F1
00350 !
00351       U1  =  U(IKLE1(IELEM))
00352       U2  =  U(IKLE2(IELEM))
00353       U3  =  U(IKLE3(IELEM))
00354 !
00355       V1  =  V(IKLE1(IELEM))
00356       V2  =  V(IKLE2(IELEM))
00357       V3  =  V(IKLE3(IELEM))
00358 !
00359       U123 = U1 + U2 + U3
00360       V123 = V1 + V2 + V3
00361 !
00362       DEN = (F3*X2 - F2*X3) * XSUR24 * SURDET(IELEM)
00363 !
00364 !   EXTRADIAGONAL TERMS
00365 !
00366       A12(IELEM) =-( (X2-X3)*(V123+V2) + (Y3-Y2)*(U123+U2) )*DEN
00367 !
00368       A13(IELEM) =-( (X2-X3)*(V123+V3) + (Y3-Y2)*(U123+U3) )*DEN
00369 !
00370       A23(IELEM) =-( X3*(V123+V3) - Y3*(U123+U3) )*DEN
00371 !
00372       A21(IELEM) =-( X3*(V123+V1) - Y3*(U123+U1) )*DEN
00373 !
00374       A31(IELEM) = ( X2*(V123+V1) - Y2*(U123+U1) )*DEN
00375 !
00376       A32(IELEM) = ( X2*(V123+V2) - Y2*(U123+U2) )*DEN
00377 !
00378 ! DIAGONAL TERMS (THE SUM OF EACH COLUMN IS 0)
00379 !
00380       A11(IELEM) = - A21(IELEM) - A31(IELEM)
00381       A22(IELEM) = - A12(IELEM) - A32(IELEM)
00382       A33(IELEM) = - A13(IELEM) - A23(IELEM)
00383 !
00384       ENDDO ! IELEM
00385 !
00386         ELSE
00387           IF (LNG.EQ.1) WRITE(LU,200) ICOORD
00388           IF (LNG.EQ.2) WRITE(LU,201) ICOORD
00389           CALL PLANTE(0)
00390           STOP
00391         ENDIF
00392 !
00393 !     OTHER TYPES OF F FUNCTIONS
00394 !
00395 !-----------------------------------------------------------------------
00396 !
00397       ELSE
00398         IF (LNG.EQ.1) WRITE(LU,100) IELMF,IELMU
00399         IF (LNG.EQ.2) WRITE(LU,101) IELMF,IELMU
00400 100     FORMAT(1X,'MT12AA (BIEF) :',/,
00401      &         1X,'COMBINAISON DE F ET U: ',1I6,2X,1I6,' NON PREVUE')
00402 101     FORMAT(1X,'MT12AA (BIEF) :',/,
00403      &        1X,'COMBINATION OF F AND U: ',1I6,2X,1I6,' NOT AVAILABLE')
00404         CALL PLANTE(0)
00405         STOP
00406       ENDIF
00407 !
00408 !-----------------------------------------------------------------------
00409 !
00410       RETURN
00411       END

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