mt08ac.f

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

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