mt13bb.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mt13bb.f
00002 !
00073                      SUBROUTINE MT13BB
00074 !                    *****************
00075 !
00076      &(  A11 , A12 , A13 , A14 ,
00077      &   A21 , A22 , A23 , A24 ,
00078      &   A31 , A32 , A33 , A34 ,
00079      &   A41 , A42 , A43 , A44 ,
00080      &   XMUL,XEL,YEL,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 !| A12            |<--| ELEMENTS OF MATRIX
00094 !| A13            |<--| ELEMENTS OF MATRIX
00095 !| A14            |<--| ELEMENTS OF MATRIX
00096 !| A21            |<--| ELEMENTS OF MATRIX
00097 !| A22            |<--| ELEMENTS OF MATRIX
00098 !| A23            |<--| ELEMENTS OF MATRIX
00099 !| A24            |<--| ELEMENTS OF MATRIX
00100 !| A31            |<--| ELEMENTS OF MATRIX
00101 !| A32            |<--| ELEMENTS OF MATRIX
00102 !| A33            |<--| ELEMENTS OF MATRIX
00103 !| A34            |<--| ELEMENTS OF MATRIX
00104 !| A41            |<--| ELEMENTS OF MATRIX
00105 !| A42            |<--| ELEMENTS OF MATRIX
00106 !| A43            |<--| ELEMENTS OF MATRIX
00107 !| A44            |<--| ELEMENTS OF MATRIX
00108 !| ICOORD         |-->| 1: DERIVATIVE ALONG X, 2: ALONG Y
00109 !| NELEM          |-->| NUMBER OF ELEMENTS
00110 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00111 !| XEL            |-->| ABSCISSAE OF POINTS IN THE MESH, PER ELEMENT
00112 !| YEL            |-->| ORDINATES OF POINTS IN THE MESH, PER ELEMENT
00113 !| XMUL           |-->| MULTIPLICATION FACTOR
00114 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00115 !
00116       USE BIEF, EX_MT13BB => MT13BB
00117 !
00118       IMPLICIT NONE
00119       INTEGER LNG,LU
00120       COMMON/INFO/LNG,LU
00121 !
00122 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00123 !
00124       INTEGER, INTENT(IN) :: NELEM,NELMAX,ICOORD
00125 !
00126       DOUBLE PRECISION, INTENT(INOUT) :: A11(*),A12(*),A13(*),A14(*)
00127       DOUBLE PRECISION, INTENT(INOUT) :: A21(*),A22(*),A23(*),A24(*)
00128       DOUBLE PRECISION, INTENT(INOUT) :: A31(*),A32(*),A33(*),A34(*)
00129       DOUBLE PRECISION, INTENT(INOUT) :: A41(*),A42(*),A43(*),A44(*)
00130 !
00131       DOUBLE PRECISION, INTENT(IN) :: XMUL
00132 !
00133       DOUBLE PRECISION, INTENT(IN) :: XEL(NELMAX,3),YEL(NELMAX,3)
00134 !
00135 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00136 !
00137       INTEGER IELEM
00138       DOUBLE PRECISION X2,X3,Y2,Y3
00139       DOUBLE PRECISION XSUR18,XSUR6
00140 !
00141 !-----------------------------------------------------------------------
00142 !
00143       XSUR6  = XMUL/6.D0
00144       XSUR18 = XMUL/18.D0
00145 !
00146 !================================
00147 !  DERIVATIVE WRT X  =
00148 !================================
00149 !
00150         IF(ICOORD.EQ.1) THEN
00151 !
00152 !   LOOP ON THE ELEMENTS
00153 !
00154         DO IELEM = 1 , NELEM
00155 !
00156 !   INITIALISES THE GEOMETRICAL VARIABLES
00157 !
00158         Y2 = YEL(IELEM,2)
00159         Y3 = YEL(IELEM,3)
00160 !
00161 !   EXTRADIAGONAL TERMS
00162 !
00163         A12(IELEM) =  (   Y2+  Y3)*XSUR18
00164         A14(IELEM) =  (-  Y2+  Y3)*XSUR6
00165         A21(IELEM) =  ( 2*Y2-  Y3)*XSUR18
00166         A24(IELEM) =        -  Y3 *XSUR6
00167         A31(IELEM) =  (   Y2-2*Y3)*XSUR18
00168         A34(IELEM) =      Y2      *XSUR6
00169         A13(IELEM) = - A12(IELEM)
00170         A23(IELEM) = - A21(IELEM)
00171         A32(IELEM) = - A31(IELEM)
00172         A41(IELEM) = - A14(IELEM)
00173         A42(IELEM) = - A24(IELEM)
00174         A43(IELEM) = - A34(IELEM)
00175 !
00176 !   DIAGONAL TERMS
00177 !   THE SUM OF THE MATRIX ROWS IS 0 (VECTOR)
00178 !
00179         A11(IELEM) = - A12(IELEM)  - A13(IELEM) - A14(IELEM)
00180         A22(IELEM) = - A21(IELEM)  - A23(IELEM) - A24(IELEM)
00181         A33(IELEM) = - A31(IELEM)  - A32(IELEM) - A34(IELEM)
00182         A44(IELEM) = 0.D0
00183 !
00184       ENDDO ! IELEM
00185 !
00186         ELSEIF(ICOORD.EQ.2) THEN
00187 !
00188 !================================
00189 !  DERIVATIVE WRT Y  =
00190 !================================
00191 !
00192         DO IELEM = 1 , NELEM
00193 !
00194 !   INITIALISES THE GEOMETRICAL VARIABLES
00195 !
00196         X2  =  XEL(IELEM,2)
00197         X3  =  XEL(IELEM,3)
00198 !
00199 !   EXTRADIAGONAL TERMS
00200 !
00201         A12(IELEM) =  (-X2-X3)*XSUR18
00202         A14(IELEM) =  (X2-X3)*XSUR6
00203         A21(IELEM) =  (-2*X2+X3)*XSUR18
00204         A24(IELEM) =   X3*XSUR6
00205         A31(IELEM) =  (-X2+2*X3)*XSUR18
00206         A34(IELEM) =  -X2*XSUR6
00207         A13(IELEM) = - A12(IELEM)
00208         A23(IELEM) = - A21(IELEM)
00209         A32(IELEM) = - A31(IELEM)
00210         A41(IELEM) = - A14(IELEM)
00211         A42(IELEM) = - A24(IELEM)
00212         A43(IELEM) = - A34(IELEM)
00213 !
00214 !   DIAGONAL TERMS
00215 !   THE SUM OF THE MATRIX COLUMN IS 0 (VECTOR)
00216 !
00217         A11(IELEM) = - A12(IELEM) - A13(IELEM) - A14(IELEM)
00218         A22(IELEM) = - A21(IELEM) - A23(IELEM) - A24(IELEM)
00219         A33(IELEM) = - A31(IELEM) - A32(IELEM) - A34(IELEM)
00220         A44(IELEM) = 0.D0
00221 !
00222         ENDDO ! IELEM
00223 !
00224         ELSE
00225 !
00226           IF (LNG.EQ.1) WRITE(LU,200) ICOORD
00227           IF (LNG.EQ.2) WRITE(LU,201) ICOORD
00228           CALL PLANTE(0)
00229 !
00230         ENDIF
00231 !
00232 200       FORMAT(1X,'MT13BB (BIEF) : COMPOSANTE IMPOSSIBLE ',
00233      &              1I6,' VERIFIER ICOORD')
00234 201       FORMAT(1X,'MT13BB (BIEF) : IMPOSSIBLE COMPONENT ',
00235      &              1I6,' CHECK ICOORD')
00236 !
00237 !-----------------------------------------------------------------------
00238 !
00239       RETURN
00240       END

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