mt13cc.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mt13cc.f
00002 !
00070                      SUBROUTINE MT13CC
00071 !                    *****************
00072 !
00073      &(  A11 , A12 , A13 , A14 , A15 , A16 ,
00074      &   A21 , A22 , A23 , A24 , A25 , A26 ,
00075      &   A31 , A32 , A33 , A34 , A35 , A36 ,
00076      &   A41 , A42 , A43 , A44 , A45 , A46 ,
00077      &   A51 , A52 , A53 , A54 , A55 , A56 ,
00078      &   A61 , A62 , A63 , A64 , A65 , A66 ,
00079      &   XMUL,XEL,YEL,NELEM,NELMAX,ICOORD)
00080 !
00081 !***********************************************************************
00082 ! BIEF   V6P1                                   21/08/2010
00083 !***********************************************************************
00084 !
00085 !
00086 !
00087 !
00088 !
00089 !
00090 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00091 !| A11            |<--| ELEMENTS OF MATRIX
00092 !| ...            |<--| ELEMENTS OF MATRIX
00093 !| A66            |<--| ELEMENTS OF MATRIX
00094 !| ICOORD         |-->| 1: DERIVATIVE ALONG X, 2: ALONG Y
00095 !| NELEM          |-->| NUMBER OF ELEMENTS
00096 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00097 !| XEL            |-->| ABSCISSAE OF POINTS IN THE MESH, PER ELEMENT
00098 !| YEL            |-->| ORDINATES OF POINTS IN THE MESH, PER ELEMENT
00099 !| XMUL           |-->| MULTIPLICATION FACTOR
00100 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00101 !
00102       USE BIEF!, EX_MT13CC => MT13CC
00103 !
00104       IMPLICIT NONE
00105       INTEGER LNG,LU
00106       COMMON/INFO/LNG,LU
00107 !
00108 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00109 !
00110       INTEGER, INTENT(IN) :: NELEM,NELMAX,ICOORD
00111 !
00112       DOUBLE PRECISION, INTENT(INOUT) :: A11(*),A12(*),A13(*)
00113       DOUBLE PRECISION, INTENT(INOUT) :: A14(*),A15(*),A16(*)
00114       DOUBLE PRECISION, INTENT(INOUT) :: A21(*),A22(*),A23(*)
00115       DOUBLE PRECISION, INTENT(INOUT) :: A24(*),A25(*),A26(*)
00116       DOUBLE PRECISION, INTENT(INOUT) :: A31(*),A32(*),A33(*)
00117       DOUBLE PRECISION, INTENT(INOUT) :: A34(*),A35(*),A36(*)
00118       DOUBLE PRECISION, INTENT(INOUT) :: A41(*),A42(*),A43(*)
00119       DOUBLE PRECISION, INTENT(INOUT) :: A44(*),A45(*),A46(*)
00120       DOUBLE PRECISION, INTENT(INOUT) :: A51(*),A52(*),A53(*)
00121       DOUBLE PRECISION, INTENT(INOUT) :: A54(*),A55(*),A56(*)
00122       DOUBLE PRECISION, INTENT(INOUT) :: A61(*),A62(*),A63(*)
00123       DOUBLE PRECISION, INTENT(INOUT) :: A64(*),A65(*),A66(*)
00124 !
00125       DOUBLE PRECISION, INTENT(IN) :: XMUL
00126 !
00127       DOUBLE PRECISION, INTENT(IN) :: XEL(NELMAX,3),YEL(NELMAX,3)
00128 !
00129 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00130 !
00131       INTEGER IELEM
00132       DOUBLE PRECISION X2,X3,Y2,Y3
00133       DOUBLE PRECISION XSUR10,XSUR15,XSUR30
00134 !
00135 !-----------------------------------------------------------------------
00136 !
00137       XSUR10 = XMUL/10.D0
00138       XSUR15 = XMUL/15.D0
00139       XSUR30 = XMUL/30.D0
00140 !
00141 !================================
00142 !  DERIVATIVE WRT X  =
00143 !================================
00144 !
00145         IF(ICOORD.EQ.1) THEN
00146 !
00147 !   LOOP ON THE ELEMENTS
00148 !
00149         DO IELEM = 1 , NELEM
00150 !
00151 !   INITIALISES THE GEOMETRICAL VARIABLES
00152 !
00153         Y2 = YEL(IELEM,2)
00154         Y3 = YEL(IELEM,3)
00155 !
00156 !   DIAGONAL TERMS
00157 !
00158         A22(IELEM) =   Y3 * XSUR15
00159         A33(IELEM) = - Y2 * XSUR15
00160         A44(IELEM) = - 4.D0 *   A33(IELEM)
00161         A55(IELEM) =   4.D0 * ( A22(IELEM) + A33(IELEM) )
00162         A66(IELEM) = - 4.D0 *   A22(IELEM)
00163         A11(IELEM) = - A22(IELEM) - A33(IELEM)
00164 !
00165 !   EXTRADIAGONAL TERMS
00166 !
00167         A12(IELEM) = - Y3 * XSUR30
00168         A13(IELEM) =   Y2 * XSUR30
00169         A42(IELEM) =   Y3 * XSUR10
00170         A53(IELEM) = - Y2 * XSUR10
00171         A14(IELEM) = - A13(IELEM) + A42(IELEM)
00172         A15(IELEM) =   A12(IELEM) + A13(IELEM)
00173         A16(IELEM) = - A12(IELEM) + A53(IELEM)
00174         A21(IELEM) = - A15(IELEM)
00175         A23(IELEM) =   A13(IELEM)
00176         A24(IELEM) = - A42(IELEM) - A33(IELEM)
00177         A25(IELEM) =   A12(IELEM) + A33(IELEM)
00178         A26(IELEM) = - A12(IELEM)
00179         A31(IELEM) = - A15(IELEM)
00180         A32(IELEM) =   A12(IELEM)
00181         A34(IELEM) = - A13(IELEM)
00182         A35(IELEM) =   A22(IELEM) + A13(IELEM)
00183         A36(IELEM) = - A53(IELEM) - A22(IELEM)
00184         A41(IELEM) = - A42(IELEM) - A53(IELEM)
00185         A43(IELEM) =   A13(IELEM)
00186         A45(IELEM) = 2.D0 *   A22(IELEM) - A44(IELEM)
00187         A46(IELEM) = 2.D0 * ( A33(IELEM) - A22(IELEM) )
00188         A51(IELEM) =   A21(IELEM)
00189         A52(IELEM) =   A42(IELEM)
00190         A54(IELEM) = - A45(IELEM)
00191         A56(IELEM) =   A66(IELEM) - 2.D0 * A33(IELEM)
00192         A61(IELEM) =   A41(IELEM)
00193         A62(IELEM) =   A12(IELEM)
00194         A63(IELEM) =   A53(IELEM)
00195         A64(IELEM) = - A46(IELEM)
00196         A65(IELEM) = - A56(IELEM)
00197 !
00198       ENDDO ! IELEM
00199 !
00200         ELSEIF(ICOORD.EQ.2) THEN
00201 !
00202 !================================
00203 !  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 !   DIAGONAL TERMS
00214 !
00215         A22(IELEM) = - X3 * XSUR15
00216         A33(IELEM) =   X2 * XSUR15
00217         A44(IELEM) = - 4.D0 *   A33(IELEM)
00218         A55(IELEM) =   4.D0 * ( A22(IELEM) + A33(IELEM) )
00219         A66(IELEM) = - 4.D0 *   A22(IELEM)
00220         A11(IELEM) = - A22(IELEM) - A33(IELEM)
00221 !
00222 !   EXTRADIAGONAL TERMS
00223 !
00224         A12(IELEM) =   X3 * XSUR30
00225         A13(IELEM) = - X2 * XSUR30
00226         A42(IELEM) = - X3 * XSUR10
00227         A53(IELEM) =   X2 * XSUR10
00228         A14(IELEM) = - A13(IELEM) + A42(IELEM)
00229         A15(IELEM) =   A12(IELEM) + A13(IELEM)
00230         A16(IELEM) = - A12(IELEM) + A53(IELEM)
00231         A21(IELEM) = - A15(IELEM)
00232         A23(IELEM) =   A13(IELEM)
00233         A24(IELEM) = - A42(IELEM) - A33(IELEM)
00234         A25(IELEM) =   A12(IELEM) + A33(IELEM)
00235         A26(IELEM) = - A12(IELEM)
00236         A31(IELEM) = - A15(IELEM)
00237         A32(IELEM) =   A12(IELEM)
00238         A34(IELEM) = - A13(IELEM)
00239         A35(IELEM) =   A22(IELEM) + A13(IELEM)
00240         A36(IELEM) = - A53(IELEM) - A22(IELEM)
00241         A41(IELEM) = - A42(IELEM) - A53(IELEM)
00242         A43(IELEM) =   A13(IELEM)
00243         A45(IELEM) = 2.D0 *   A22(IELEM) - A44(IELEM)
00244         A46(IELEM) = 2.D0 * ( A33(IELEM) - A22(IELEM) )
00245         A51(IELEM) =   A21(IELEM)
00246         A52(IELEM) =   A42(IELEM)
00247         A54(IELEM) = - A45(IELEM)
00248         A56(IELEM) =   A66(IELEM) - 2.D0 * A33(IELEM)
00249         A61(IELEM) =   A41(IELEM)
00250         A62(IELEM) =   A12(IELEM)
00251         A63(IELEM) =   A53(IELEM)
00252         A64(IELEM) = - A46(IELEM)
00253         A65(IELEM) = - A56(IELEM)
00254 !
00255 !
00256         ENDDO ! IELEM
00257 !
00258         ELSE
00259 !
00260           IF (LNG.EQ.1) WRITE(LU,200) ICOORD
00261           IF (LNG.EQ.2) WRITE(LU,201) ICOORD
00262           CALL PLANTE(1)
00263 !
00264         ENDIF
00265 !
00266 200       FORMAT(1X,'MT13CC (BIEF) : COMPOSANTE IMPOSSIBLE ',
00267      &              1I6,' VERIFIER ICOORD')
00268 201       FORMAT(1X,'MT13CC (BIEF) : IMPOSSIBLE COMPONENT ',
00269      &              1I6,' CHECK ICOORD')
00270 !
00271 !-----------------------------------------------------------------------
00272 !
00273       RETURN
00274       END

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