mt05aa.f

Go to the documentation of this file.
```00001 C:\opentelemac\v7p0\sources\utils\bief\mt05aa.f
00002 !
00074                      SUBROUTINE MT05AA
00075 !                    *****************
00076 !
00077      &( A11 , A12 , A13 ,
00078      &  A21 , A22 , A23 ,
00079      &  A31 , A32 , A33 ,
00080      &  XMUL,SU,SV,U,V,
00081      &  XEL,YEL,IKLE,NELEM,NELMAX,FORMUL)
00082 !
00083 !***********************************************************************
00084 ! BIEF   V6P1                                   21/08/2010
00085 !***********************************************************************
00086 !
00087 !
00088 !
00089 !
00090 !
00091 !
00092 !
00093 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00094 !| A11            |<--| ELEMENTS OF MATRIX
00095 !| A12            |<--| ELEMENTS OF MATRIX
00096 !| A13            |<--| ELEMENTS OF MATRIX
00097 !| A21            |<--| ELEMENTS OF MATRIX
00098 !| A22            |<--| ELEMENTS OF MATRIX
00099 !| A23            |<--| ELEMENTS OF MATRIX
00100 !| A31            |<--| ELEMENTS OF MATRIX
00101 !| A32            |<--| ELEMENTS OF MATRIX
00102 !| A33            |<--| ELEMENTS OF MATRIX
00103 !| FORMUL         |-->| FORMULA DESCRIBING THE RESULTING MATRIX
00104 !| IKLE1          |-->| FIRST POINTS OF TRIANGLES
00105 !| IKLE2          |-->| SECOND POINTS OF TRIANGLES
00106 !| IKLE3          |-->| THIRD POINTS OF TRIANGLES
00107 !| IKLE4          |-->| QUASI-BUBBLE POINT
00108 !| NELEM          |-->| NUMBER OF ELEMENTS
00109 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00110 !| SU             |-->| BIEF_OBJ STRUCTURE OF U
00111 !| SURFAC         |-->| AREA OF TRIANGLES
00112 !| SV             |-->| BIEF_OBJ STRUCTURE OF V
00113 !| U              |-->| FUNCTION U USED IN THE FORMULA
00114 !| V              |-->| FUNCTION V USED IN THE FORMULA
00115 !| XEL            |-->| ABSCISSAE OF POINTS IN THE MESH, PER ELEMENT
00116 !| YEL            |-->| ORDINATES OF POINTS IN THE MESH, PER ELEMENT
00117 !| XMUL           |-->| MULTIPLICATION FACTOR
00118 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00119 !
00120       USE BIEF, EX_MT05AA => MT05AA
00121 !
00122       IMPLICIT NONE
00123       INTEGER LNG,LU
00124       COMMON/INFO/LNG,LU
00125 !
00126 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00127 !
00128       INTEGER, INTENT(IN) :: NELEM,NELMAX
00129       INTEGER, INTENT(IN) :: IKLE(NELMAX,*)
00130       DOUBLE PRECISION, INTENT(INOUT) :: A11(*),A12(*),A13(*)
00131       DOUBLE PRECISION, INTENT(INOUT) :: A21(*),A22(*),A23(*)
00132       DOUBLE PRECISION, INTENT(INOUT) :: A31(*),A32(*),A33(*)
00133       DOUBLE PRECISION, INTENT(IN)    :: XMUL,U(*),V(*)
00134       TYPE(BIEF_OBJ), INTENT(IN)      :: SU,SV
00135       CHARACTER(LEN=16) :: FORMUL
00136       DOUBLE PRECISION, INTENT(IN) :: XEL(NELMAX,3),YEL(NELMAX,3)
00137 !
00138 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00139 !
00140 !     DECLARATIONS SPECIFIC TO THIS SUBROUTINE
00141 !
00142       INTEGER IELMU,IELMV,IELEM
00143 !
00144       DOUBLE PRECISION SUR24,SUR120,SUR216
00145       DOUBLE PRECISION X2,X3,Y2,Y3
00146       DOUBLE PRECISION U1,U2,U3,U4,U5,U6,V1,V2,V3,V4,V5,V6
00147       DOUBLE PRECISION U123,V123,COU1,COV1,COU2,COV2,COU3,COV3
00148       DOUBLE PRECISION QUATRU,QUATRV,SUR6,USUR2,VSUR2
00149       DOUBLE PRECISION K1,K2,K3,L12,L13,L21,L23,L31,L32
00150 !
00151       INTRINSIC MAX,MIN
00152 !
00153 !-----------------------------------------------------------------------
00154 !
00155       SUR6   = XMUL/  6.D0
00156       SUR24  = XMUL/ 24.D0
00157       SUR120 = XMUL/120.D0
00158       SUR216 = XMUL/216.D0
00159 !
00160 !-----------------------------------------------------------------------
00161 !
00162       IELMU = SU%ELM
00163       IELMV = SV%ELM
00164 !
00165 !-----------------------------------------------------------------------
00166 !
00167 !  CASE WHERE U AND V ARE CONSTANT BY ELEMENT
00168 !
00169       IF(IELMU.EQ.10.AND.IELMV.EQ.10) THEN
00170 !
00171 !   LOOP ON THE ELEMENTS
00172 !
00173       DO IELEM = 1 , NELEM
00174 !
00175       X2  =   XEL(IELEM,2) * SUR24
00176       X3  =   XEL(IELEM,3) * SUR24
00177       Y2  =   YEL(IELEM,2) * SUR24
00178       Y3  =   YEL(IELEM,3) * SUR24
00179 !
00180       QUATRU = 4 * U(IELEM)
00181       QUATRV = 4 * V(IELEM)
00182 !
00183 !   DIAGONAL TERMS
00184 !
00185       A11(IELEM)    = (X3-X2) * QUATRV + (Y2-Y3) * QUATRU
00186       A22(IELEM)    = -X3     * QUATRV      +Y3  * QUATRU
00187       A33(IELEM)    =     X2  * QUATRV -  Y2     * QUATRU
00188 !
00190 !
00191       A12(IELEM)  = -X3     * QUATRV +     Y3  * QUATRU
00192       A13(IELEM)  =     X2  * QUATRV - Y2      * QUATRU
00193       A23(IELEM)  =     X2  * QUATRV - Y2      * QUATRU
00194       A21(IELEM)  = (X3-X2) * QUATRV + (Y2-Y3) * QUATRU
00195       A31(IELEM)  = (X3-X2) * QUATRV + (Y2-Y3) * QUATRU
00196       A32(IELEM)  = -X3     * QUATRV +     Y3  * QUATRU
00197 !
00198       ENDDO ! IELEM
00199 !
00200 !-----------------------------------------------------------------------
00201 !
00202 !  CASE WHERE U AND V ARE LINEAR, QUASI-BUBBLE OR QUADRATIC AND N SCHEME
00203 !
00204       ELSEIF(FORMUL(16:16).EQ.'N'   .AND.
00205      & ( (IELMU.EQ.11.AND.IELMV.EQ.11).OR.
00206      &   (IELMU.EQ.12.AND.IELMV.EQ.12).OR.
00207      &   (IELMU.EQ.13.AND.IELMV.EQ.13)      )  ) THEN
00208 !
00209 !     N SCHEME: U AND V ARE TREATED AS IF LINEAR
00210 !
00211       DO IELEM = 1 , NELEM
00212 !
00213         X2 = XEL(IELEM,2)
00214         X3 = XEL(IELEM,3)
00215         Y2 = YEL(IELEM,2)
00216         Y3 = YEL(IELEM,3)
00217 !
00218         U1 = U(IKLE(IELEM,1))
00219         U2 = U(IKLE(IELEM,2))
00220         U3 = U(IKLE(IELEM,3))
00221         V1 = V(IKLE(IELEM,1))
00222         V2 = V(IKLE(IELEM,2))
00223         V3 = V(IKLE(IELEM,3))
00224 !
00225         USUR2 = (U1+U2+U3)*SUR6
00226         VSUR2 = (V1+V2+V3)*SUR6
00227 !
00228         K1 = USUR2 * (Y2-Y3) - VSUR2 * (X2-X3)
00229         K2 = USUR2 * (Y3   ) - VSUR2 * (X3   )
00230         K3 = USUR2 * (  -Y2) - VSUR2 * (  -X2)
00231 !
00232         L12 = MAX(  MIN(K1,-K2) , 0.D0 )
00233         L13 = MAX(  MIN(K1,-K3) , 0.D0 )
00234         L21 = MAX(  MIN(K2,-K1) , 0.D0 )
00235         L23 = MAX(  MIN(K2,-K3) , 0.D0 )
00236         L31 = MAX(  MIN(K3,-K1) , 0.D0 )
00237         L32 = MAX(  MIN(K3,-K2) , 0.D0 )
00238 !
00239 !   DIAGONAL TERMS
00240 !
00241         A11(IELEM)  = L12 + L13
00242         A22(IELEM)  = L21 + L23
00243         A33(IELEM)  = L31 + L32
00244 !
00246 !
00247         A12(IELEM)  = - L12
00248         A13(IELEM)  = - L13
00249         A23(IELEM)  = - L23
00250         A21(IELEM)  = - L21
00251         A31(IELEM)  = - L31
00252         A32(IELEM)  = - L32
00253 !
00254       ENDDO ! IELEM
00255 !
00256       ELSEIF(IELMU.EQ.11.AND.IELMV.EQ.11) THEN
00257 !
00258 !   TRADITIONAL SCHEME, U AND V LINEAR
00259 !
00260 !   LOOP ON THE ELEMENTS
00261 !
00262       DO IELEM = 1 , NELEM
00263 !
00264       X2  =   XEL(IELEM,2) * SUR24
00265       X3  =   XEL(IELEM,3) * SUR24
00266       Y2  =   YEL(IELEM,2) * SUR24
00267       Y3  =   YEL(IELEM,3) * SUR24
00268 !
00269       U1   =  U(IKLE(IELEM,1))
00270       U2   =  U(IKLE(IELEM,2))
00271       U3   =  U(IKLE(IELEM,3))
00272       V1   =  V(IKLE(IELEM,1))
00273       V2   =  V(IKLE(IELEM,2))
00274       V3   =  V(IKLE(IELEM,3))
00275 !
00276       U123 =  U1 + U2 + U3
00277       V123 =  V1 + V2 + V3
00278 !
00279 !   DIAGONAL TERMS
00280 !
00281       A11(IELEM)    = (X3-X2) * (V123+V1) + (Y2-Y3) * (U123+U1)
00282       A22(IELEM)    = -X3     * (V123+V2)      +Y3  * (U123+U2)
00283       A33(IELEM)    =     X2  * (V123+V3) -  Y2     * (U123+U3)
00284 !
00286 !
00287       A12(IELEM)  = -X3     * (V123+V1) +     Y3  * (U123+U1)
00288       A13(IELEM)  =     X2  * (V123+V1) -  Y2     * (U123+U1)
00289       A23(IELEM)  =     X2  * (V123+V2) -  Y2     * (U123+U2)
00290       A21(IELEM)  = (X3-X2) * (V123+V2) + (Y2-Y3) * (U123+U2)
00291       A31(IELEM)  = (X3-X2) * (V123+V3) + (Y2-Y3) * (U123+U3)
00292       A32(IELEM)  = -X3     * (V123+V3) +     Y3  * (U123+U3)
00293 !
00294       ENDDO ! IELEM
00295 !
00296 !-----------------------------------------------------------------------
00297 !
00298       ELSEIF(IELMU.EQ.12.AND.IELMV.EQ.12) THEN
00299 !
00300 !   TRADITIONAL SCHEME, U AND V QUASI-BUBBLE
00301 !
00302 !   LOOP ON THE ELEMENTS
00303 !
00304       DO IELEM = 1 , NELEM
00305 !
00306       X2  =   XEL(IELEM,2)
00307       X3  =   XEL(IELEM,3)
00308       Y2  =   YEL(IELEM,2)
00309       Y3  =   YEL(IELEM,3)
00310 !
00311       U1   =  U(IKLE(IELEM,1))
00312       U2   =  U(IKLE(IELEM,2))
00313       U3   =  U(IKLE(IELEM,3))
00314       U4   =  U(IKLE(IELEM,4))
00315       V1   =  V(IKLE(IELEM,1))
00316       V2   =  V(IKLE(IELEM,2))
00317       V3   =  V(IKLE(IELEM,3))
00318       V4   =  V(IKLE(IELEM,4))
00319 !
00320       COV1 =  5*V3+12*V4+5*V2+14*V1
00321       COU1 =  5*U3+12*U4+5*U2+14*U1
00322       COV2 =  5*V3+12*V4+14*V2+5*V1
00323       COU2 =  5*U3+12*U4+14*U2+5*U1
00324       COV3 =  14*V3+12*V4+5*V2+5*V1
00325       COU3 =  14*U3+12*U4+5*U2+5*U1
00326 !
00328 !
00329       A12(IELEM)  = ( -X3*COV1 + Y3*COU1 )*SUR216
00330       A13(IELEM)  = (  X2*COV1 - Y2*COU1 )*SUR216
00331       A21(IELEM)  = ( (X3-X2)*COV2 + (Y2-Y3)*COU2 )*SUR216
00332       A23(IELEM)  = (  X2*COV2 - Y2*COU2 )*SUR216
00333       A31(IELEM)  = ( (X3-X2)*COV3 + (Y2-Y3)*COU3 )*SUR216
00334       A32(IELEM)  = ( -X3*COV3 + Y3*COU3 )*SUR216
00335 !
00336 !   DIAGONAL TERMS (SUM OF EACH COLUMN = 0)
00337 !
00338       A11(IELEM) = - A12(IELEM) - A13(IELEM)
00339       A22(IELEM) = - A21(IELEM) - A23(IELEM)
00340       A33(IELEM) = - A31(IELEM) - A32(IELEM)
00341 !
00342       ENDDO ! IELEM
00343 !
00344 !-----------------------------------------------------------------------
00345 !
00346       ELSEIF(IELMU.EQ.13.AND.IELMV.EQ.13) THEN
00347 !
00348 !   TRADITIONAL SCHEME, U AND V P2
00349 !
00350 !   LOOP ON THE ELEMENTS
00351 !
00352       DO IELEM = 1 , NELEM
00353 !
00354       X2  =   XEL(IELEM,2)
00355       X3  =   XEL(IELEM,3)
00356       Y2  =   YEL(IELEM,2)
00357       Y3  =   YEL(IELEM,3)
00358 !
00359       U1   =  U(IKLE(IELEM,1))
00360       U2   =  U(IKLE(IELEM,2))
00361       U3   =  U(IKLE(IELEM,3))
00362       U4   =  U(IKLE(IELEM,4))
00363       U5   =  U(IKLE(IELEM,5))
00364       U6   =  U(IKLE(IELEM,6))
00365       V1   =  V(IKLE(IELEM,1))
00366       V2   =  V(IKLE(IELEM,2))
00367       V3   =  V(IKLE(IELEM,3))
00368       V4   =  V(IKLE(IELEM,4))
00369       V5   =  V(IKLE(IELEM,5))
00370       V6   =  V(IKLE(IELEM,6))
00371 !
00373 !
00374       A12(IELEM) = ((V3+V2-2.D0*V1-4.D0*V5-8.D0*(V4+V6)) * X3
00375      &           -  (U2-4.D0*U5-8.D0*(U4+U6)-2.D0*U1+U3) * Y3) * SUR120
00376       A13(IELEM) = ((2.D0*V1-V3-V2+4.D0*V5+8.D0*(V4+V6)) * X2
00377      &           +  (U2-4.D0*U5-8.D0*(U4+U6)-2.D0*U1+U3) * Y2) * SUR120
00378       A21(IELEM) = ((V1-8.D0*(V4+V5)-4.D0*V6+V3-2.D0*V2) * (X2-X3)
00379      &           +  (2.D0*U2-U3-U1+8.D0*(U5+U4)+4.D0*U6) * (Y2-Y3))
00380      &           *   SUR120
00381       A23(IELEM) = ((8.D0*(V4+V5)-V1+4.D0*V6-V3+2.D0*V2) * X2
00382      &           -  (2.D0*U2-U3-U1+8.D0*(U5+U4)+4.D0*U6) * Y2) * SUR120
00383       A31(IELEM) = ((V1+V2-4.D0*V4-2.D0*V3-8.D0*(V6+V5)) * (X2-X3)
00384      &           +  (4.D0*U4-U2+8.D0*(U6+U5)+2.D0*U3-U1) * (Y2-Y3))
00385      &           *   SUR120
00386       A32(IELEM) = ((V1+V2-4.D0*V4-2.D0*V3-8.D0*(V6+V5)) * X3
00387      &           +  (4.D0*U4-U2+8.D0*(U6+U5)+2.D0*U3-U1) * Y3) * SUR120
00388 !
00389 !   DIAGONAL TERMS (SUM OF EACH COLUMN = 0)
00390 !
00391       A11(IELEM) = - A12(IELEM) - A13(IELEM)
00392       A22(IELEM) = - A21(IELEM) - A23(IELEM)
00393       A33(IELEM) = - A31(IELEM) - A32(IELEM)
00394 !
00395       ENDDO ! IELEM
00396 !
00397 !     OTHER TYPES OF U AND V DISCRETISATION
00398 !
00399 !-----------------------------------------------------------------------
00400 !
00401       ELSE
00402 !
00403         IF(IELMU.EQ.IELMV) THEN
00404         IF (LNG.EQ.1) WRITE(LU,100) IELMU
00405         IF (LNG.EQ.2) WRITE(LU,101) IELMU
00406 100     FORMAT(1X,'MT05AA (BIEF) :',/,
00407      &         1X,'DISCRETISATION DE U ET V : ',1I6,' NON PREVUE')
00408 101     FORMAT(1X,'MT05AA (BIEF) :',/,
00409      &         1X,'DISCRETIZATION OF U AND V : ',1I6,' NOT AVAILABLE')
00410         ELSE
00411         IF (LNG.EQ.1) WRITE(LU,200) IELMU,IELMV
00412         IF (LNG.EQ.2) WRITE(LU,201) IELMU,IELMV
00413 200     FORMAT(1X,'MT05AA (BIEF) :',/,
00414      &         1X,'U ET V DE DISCRETISATIONS DIFFERENTES :',1I6,3X,1I6)
00415 201     FORMAT(1X,'MT05AA (BIEF) :',/,
00416      &         1X,'U AND V OF A DIFFERENT DISCRETISATION:',1I6,3X,1I6)
00417         ENDIF
00418 !
00419         CALL PLANTE(1)
00420         STOP
00421 !
00422       ENDIF
00423 !
00424 !-----------------------------------------------------------------------
00425 !
00426       RETURN
00427       END
```