mt08aa.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mt08aa.f
00002 !
00075                      SUBROUTINE MT08AA
00076 !                    *****************
00077 !
00078      &(  A11 , A12 , A13 ,
00079      &   A21 , A22 , A23 ,
00080      &   A31 , A32 , A33 ,
00081      &   XMUL,SF,F,XEL,YEL,IKLE1,IKLE2,IKLE3,NELEM,NELMAX,ICOORD)
00082 !
00083 !***********************************************************************
00084 ! BIEF   V6P1                                   21/08/2010
00085 !***********************************************************************
00086 !
00087 !
00088 !
00089 !
00090 !
00091 !
00092 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00093 !| A11            |<--| ELEMENTS OF MATRIX
00094 !| A12            |<--| ELEMENTS OF MATRIX
00095 !| A13            |<--| ELEMENTS OF MATRIX
00096 !| A21            |<--| ELEMENTS OF MATRIX
00097 !| A22            |<--| ELEMENTS OF MATRIX
00098 !| A23            |<--| ELEMENTS OF MATRIX
00099 !| A31            |<--| ELEMENTS OF MATRIX
00100 !| A32            |<--| ELEMENTS OF MATRIX
00101 !| A33            |<--| ELEMENTS OF MATRIX
00102 !| F              |-->| FUNCTION USED IN THE FORMULA
00103 !| ICOORD         |-->| 1: DERIVATIVE ALONG X, 2: ALONG Y
00104 !| IKLE1          |-->| FIRST POINTS OF TRIANGLES
00105 !| IKLE2          |-->| SECOND POINTS OF TRIANGLES
00106 !| IKLE3          |-->| THIRD POINTS OF TRIANGLES
00107 !| NELEM          |-->| NUMBER OF ELEMENTS
00108 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00109 !| SF             |-->| STRUCTURE OF FUNCTIONS F
00110 !| XEL            |-->| ABSCISSAE OF POINTS IN THE MESH, PER ELEMENT
00111 !| YEL            |-->| ORDINATES OF POINTS IN THE MESH, PER ELEMENT
00112 !| XMUL           |-->| MULTIPLICATION FACTOR
00113 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00114 !
00115       USE BIEF, EX_MT08AA => MT08AA
00116 !
00117       IMPLICIT NONE
00118       INTEGER LNG,LU
00119       COMMON/INFO/LNG,LU
00120 !
00121 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00122 !
00123       INTEGER, INTENT(IN) :: NELEM,NELMAX,ICOORD
00124       INTEGER, INTENT(IN) :: IKLE1(NELMAX),IKLE2(NELMAX),IKLE3(NELMAX)
00125 !
00126       DOUBLE PRECISION, INTENT(INOUT) :: A11(*),A12(*),A13(*)
00127       DOUBLE PRECISION, INTENT(INOUT) :: A21(*),A22(*),A23(*)
00128       DOUBLE PRECISION, INTENT(INOUT) :: A31(*),A32(*),A33(*)
00129 !
00130       DOUBLE PRECISION, INTENT(IN) :: XMUL
00131       DOUBLE PRECISION, INTENT(IN) :: F(*)
00132 !
00133 !     STRUCTURE OF F
00134       TYPE(BIEF_OBJ), INTENT(IN) :: SF
00135 !
00136       DOUBLE PRECISION, INTENT(IN) :: XEL(NELMAX,3),YEL(NELMAX,3)
00137 !
00138 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00139 !
00140       INTEGER IELEM,IELMF
00141       DOUBLE PRECISION SUR24,X2,X3,Y2,Y3,F1,F2,F3,F123
00142 !
00143 !-----------------------------------------------------------------------
00144 !
00145       SUR24 = XMUL/24.D0
00146 !
00147 !-----------------------------------------------------------------------
00148 !
00149       IELMF=SF%ELM
00150 !
00151 !  CASE WHERE F IS OF P1 DISCRETISATION
00152 !
00153       IF((IELMF.EQ.11).OR.(IELMF.EQ.12)) THEN
00154 !
00155 ! TH
00156 ! SAME MATRIX IF F IS QUASI-BUBBLE
00157 ! TH
00158 !
00159 !================================
00160 !  CASE OF DERIVATIVE WRT X =
00161 !================================
00162 !
00163       IF(ICOORD.EQ.1) THEN
00164 !
00165 !   LOOP ON THE ELEMENTS
00166 !
00167       DO IELEM = 1 , NELEM
00168 !
00169 !   INITIALISES THE GEOMETRICAL VARIABLES
00170 !
00171       Y2 = YEL(IELEM,2)
00172       Y3 = YEL(IELEM,3)
00173 !
00174       F1  =  F(IKLE1(IELEM)) * SUR24
00175       F2  =  F(IKLE2(IELEM)) * SUR24
00176       F3  =  F(IKLE3(IELEM)) * SUR24
00177       F123 = F1 + F2 + F3
00178 !
00179 !   EXTRADIAGONAL TERMS
00180 !
00181       A12(IELEM) = (Y3-Y2) * (  F123 + F2  )
00182       A13(IELEM) = (Y3-Y2) * (  F123 + F3  )
00183       A23(IELEM) =  Y3     * ( -F123 - F3  )
00184       A21(IELEM) =  Y3     * ( -F123 - F1  )
00185       A31(IELEM) =     Y2  * (  F123 + F1  )
00186       A32(IELEM) =     Y2  * (  F123 + F2  )
00187 !
00188 !   DIAGONAL TERMS
00189 !
00190       A11(IELEM) = - A21(IELEM) - A31(IELEM)
00191       A22(IELEM) = - A12(IELEM) - A32(IELEM)
00192       A33(IELEM) = - A13(IELEM) - A23(IELEM)
00193 !
00194       ENDDO ! IELEM
00195 !
00196       ELSEIF(ICOORD.EQ.2) THEN
00197 !
00198 !================================
00199 !  CASE OF DERIVATIVE WRT Y =
00200 !================================
00201 !
00202       DO IELEM = 1 , NELEM
00203 !
00204 !   INITIALISES THE GEOMETRICAL VARIABLES
00205 !
00206       X2  =  XEL(IELEM,2)
00207       X3  =  XEL(IELEM,3)
00208 !
00209       F1  =  F(IKLE1(IELEM)) * SUR24
00210       F2  =  F(IKLE2(IELEM)) * SUR24
00211       F3  =  F(IKLE3(IELEM)) * SUR24
00212       F123 = F1 + F2 + F3
00213 !
00214 !   EXTRADIAGONAL TERMS
00215 !
00216       A12(IELEM) = (X2-X3) * (  F123 + F2  )
00217       A13(IELEM) = (X2-X3) * (  F123 + F3  )
00218       A23(IELEM) =     X3  * (  F123 + F3  )
00219       A21(IELEM) =     X3  * (  F123 + F1  )
00220       A31(IELEM) =  X2     * ( -F123 - F1  )
00221       A32(IELEM) =  X2     * ( -F123 - F2  )
00222 !
00223 !   DIAGONAL TERMS
00224 !
00225       A11(IELEM) = -A21(IELEM) -A31(IELEM)
00226       A22(IELEM) = -A12(IELEM) -A32(IELEM)
00227       A33(IELEM) = -A13(IELEM) -A23(IELEM)
00228 !
00229       ENDDO ! IELEM
00230 !
00231         ELSE
00232 !
00233           IF (LNG.EQ.1) WRITE(LU,200) ICOORD
00234           IF (LNG.EQ.2) WRITE(LU,201) ICOORD
00235 200       FORMAT(1X,'MT08AA (BIEF) : COMPOSANTE IMPOSSIBLE ',
00236      &              1I6,' VERIFIER ICOORD')
00237 201       FORMAT(1X,'MT08AA (BIEF) : IMPOSSIBLE COMPONENT ',
00238      &              1I6,' CHECK ICOORD')
00239           CALL PLANTE(1)
00240         ENDIF
00241 !
00242 !     ELSEIF(IELMF.EQ. ) THEN
00243 !     OTHER TYPES OF FUNCTIONS F
00244 !
00245 !-----------------------------------------------------------------------
00246 !
00247       ELSE
00248         IF (LNG.EQ.1) WRITE(LU,100) IELMF
00249         IF (LNG.EQ.2) WRITE(LU,101) IELMF
00250 100     FORMAT(1X,'MT08AA (BIEF) :',/,
00251      &         1X,'DISCRETISATION DE F : ',1I6,' NON PREVUE')
00252 101     FORMAT(1X,'MT08AA (BIEF) :',/,
00253      &         1X,'DISCRETIZATION OF F : ',1I6,' NOT AVAILABLE')
00254         CALL PLANTE(1)
00255         STOP
00256       ENDIF
00257 !
00258 !-----------------------------------------------------------------------
00259 !
00260       RETURN
00261       END

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