mt11aa.f

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

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