mt03aa.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mt03aa.f
00002 !
00068                      SUBROUTINE MT03AA
00069 !                    *****************
00070 !
00071      &( A11 , A12 , A13 ,
00072      &  A21 , A22 , A23 ,
00073      &  A31 , A32 , A33 ,
00074      &  XMUL,SF,SG,SU,SV,F,G,U,V,
00075      &  XEL,YEL,SURFAC,IKLE1,IKLE2,IKLE3,IKLE4,NELEM,NELMAX)
00076 !
00077 !***********************************************************************
00078 ! BIEF   V6P1                                  21/08/2010
00079 !***********************************************************************
00080 !
00081 !
00082 !
00083 !
00084 !
00085 !
00086 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00087 !| A11            |<--| ELEMENTS OF MATRIX
00088 !| A12            |<--| ELEMENTS OF MATRIX
00089 !| A13            |<--| ELEMENTS OF MATRIX
00090 !| A21            |<--| ELEMENTS OF MATRIX
00091 !| A22            |<--| ELEMENTS OF MATRIX
00092 !| A23            |<--| ELEMENTS OF MATRIX
00093 !| A31            |<--| ELEMENTS OF MATRIX
00094 !| A32            |<--| ELEMENTS OF MATRIX
00095 !| A33            |<--| ELEMENTS OF MATRIX
00096 !| F              |-->| FUNCTION USED IN THE FORMULA
00097 !| G              |-->| FUNCTION USED IN THE FORMULA
00098 !| IKLE1          |-->| FIRST POINTS OF TRIANGLES
00099 !| IKLE2          |-->| SECOND POINTS OF TRIANGLES
00100 !| IKLE3          |-->| THIRD POINTS OF TRIANGLES
00101 !| IKLE4          |-->| QUASI-BUBBLE POINT
00102 !| NELEM          |-->| NUMBER OF ELEMENTS
00103 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00104 !| SF             |-->| STRUCTURE OF FUNCTIONS F
00105 !| SG             |-->| STRUCTURE OF FUNCTIONS G
00106 !| SU             |-->| BIEF_OBJ STRUCTURE OF U
00107 !| SURFAC         |-->| AREA OF TRIANGLES
00108 !| SV             |-->| BIEF_OBJ STRUCTURE OF V
00109 !| U              |-->| FUNCTION U USED IN THE FORMULA
00110 !| V              |-->| FUNCTION V USED IN THE FORMULA
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_MT03AA => MT03AA
00117 !
00118       IMPLICIT NONE
00119       INTEGER LNG,LU
00120       COMMON/INFO/LNG,LU
00121 !
00122 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00123 !
00124       INTEGER, INTENT(IN) :: NELEM,NELMAX
00125       INTEGER, INTENT(IN) :: IKLE1(NELMAX),IKLE2(NELMAX)
00126       INTEGER, INTENT(IN) :: IKLE3(NELMAX),IKLE4(NELMAX)
00127 !
00128       DOUBLE PRECISION, INTENT(INOUT) :: A11(*),A12(*),A13(*)
00129       DOUBLE PRECISION, INTENT(INOUT) :: A21(*),A22(*),A23(*)
00130       DOUBLE PRECISION, INTENT(INOUT) :: A31(*),A32(*),A33(*)
00131 !
00132       DOUBLE PRECISION, INTENT(IN) :: XMUL
00133       DOUBLE PRECISION, INTENT(IN) :: F(*),G(*),U(*),V(*)
00134 !
00135 !     STRUCTURES OF      F, G, U, V
00136       TYPE(BIEF_OBJ), INTENT(IN) :: SF,SG,SU,SV
00137 !
00138       DOUBLE PRECISION, INTENT(IN) :: XEL(NELMAX,3),YEL(NELMAX,3)
00139       DOUBLE PRECISION, INTENT(IN) :: SURFAC(NELMAX)
00140 !
00141 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00142 !
00143 !     DECLARATIONS SPECIFIC TO THIS SUBROUTINE
00144 !
00145       INTEGER IELMF,IELMG,IELMU,IELMV,IELEM
00146 !
00147       DOUBLE PRECISION SUR12,SUR36,X2,X3,Y2,Y3,U1,U2,U3,U4,V1,V2,V3,V4
00148       DOUBLE PRECISION V123,U123,DEN,KKX,KKY,AUX1,AUX2,AUX3,AUX4
00149 !
00150 !-----------------------------------------------------------------------
00151 !
00152       SUR12 = XMUL/12.D0
00153       SUR36 = XMUL/36.D0
00154 !
00155 !-----------------------------------------------------------------------
00156 !
00157       IELMF = SF%ELM
00158       IELMG = SG%ELM
00159       IELMU = SU%ELM
00160       IELMV = SV%ELM
00161 !
00162       IF(IELMF.EQ.10.AND.IELMG.EQ.10.AND.
00163      &   IELMU.EQ.11.AND.IELMV.EQ.11) THEN
00164 !
00165 !   LOOP ON THE ELEMENTS
00166 !
00167       DO IELEM = 1 , NELEM
00168 !
00169       X2  =  XEL(IELEM,2)
00170       X3  =  XEL(IELEM,3)
00171       Y2  =  YEL(IELEM,2)
00172       Y3  =  YEL(IELEM,3)
00173 !
00174       U1  =  U(IKLE1(IELEM))
00175       U2  =  U(IKLE2(IELEM))
00176       U3  =  U(IKLE3(IELEM))
00177       V1  =  V(IKLE1(IELEM))
00178       V2  =  V(IKLE2(IELEM))
00179       V3  =  V(IKLE3(IELEM))
00180 !
00181       U123 = U1 + U2 + U3
00182       V123 = V1 + V2 + V3
00183 !
00184       DEN = SUR12 / SURFAC(IELEM)
00185       KKX = F(IELEM)*DEN
00186       KKY = G(IELEM)*DEN
00187 !
00188       AUX1 = X2 * V123 - Y2 * U123
00189       AUX2 = X3 * V123 - Y3 * U123
00190       AUX3 = X2 * KKY  - Y2 * KKX
00191       AUX4 = X3 * KKY  - Y3 * KKX
00192 !
00193       A11(IELEM)  = ( AUX1 - AUX2 ) * ( AUX3 - AUX4 )
00194       A22(IELEM)  =          AUX2   *          AUX4
00195       A12(IELEM)  =          AUX2   * ( AUX3 - AUX4 )
00196       A21(IELEM)  = ( AUX1 - AUX2 ) *          AUX4
00197 !
00198 !  USES HERE THE 'MAGIC SQUARE' PROPERTIES OF A DIFFUSION-LIKE MATRIX
00199 !  (SUM OF EACH LINE AND EACH COLUMN IS 0)
00200 !
00201       A13(IELEM) = - A11(IELEM) - A12(IELEM)
00202       A23(IELEM) = - A22(IELEM) - A21(IELEM)
00203       A31(IELEM) = - A11(IELEM) - A21(IELEM)
00204       A32(IELEM) = - A22(IELEM) - A12(IELEM)
00205       A33(IELEM) = - A13(IELEM) - A23(IELEM)
00206 !
00207       ENDDO ! IELEM
00208 !
00209 !-----------------------------------------------------------------------
00210 !
00211       ELSEIF(IELMF.EQ.10.AND.IELMG.EQ.10.AND.IELMU.EQ.12) THEN
00212 !
00213 !   LOOP ON THE ELEMENTS
00214 !
00215       DO IELEM = 1 , NELEM
00216 !
00217       X2  =   XEL(IELEM,2)
00218       X3  =   XEL(IELEM,3)
00219       Y2  =   YEL(IELEM,2)
00220       Y3  =   YEL(IELEM,3)
00221 !
00222       U1   =  U(IKLE1(IELEM))
00223       U2   =  U(IKLE2(IELEM))
00224       U3   =  U(IKLE3(IELEM))
00225       U4   =  U(IKLE4(IELEM))
00226       V1   =  V(IKLE1(IELEM))
00227       V2   =  V(IKLE2(IELEM))
00228       V3   =  V(IKLE3(IELEM))
00229       V4   =  V(IKLE4(IELEM))
00230 !
00231       DEN = SUR36 / SURFAC(IELEM)
00232       KKX=F(IELEM)*DEN
00233       KKY=G(IELEM)*DEN
00234 !
00235       A11(IELEM) = ((X2*KKY-X3*KKY+KKX*Y3-KKX*Y2)*(2*X2*V3+3*X2*V4+
00236      &          2*X2*V2+2*X2*V1-2*X3*V3-3*X3*V4-2*X3*V2-2*X3*V1+2*
00237      &          U3*Y3-2*U3*Y2+3*U4*Y3-3*U4*Y2+2*U2*Y3-2*U2*Y2+2*U1*
00238      &          Y3-2*U1*Y2))
00239       A22(IELEM) = ((X3*KKY-KKX*Y3)*(2*X3*V3+3*X3*V4+2*X3*V2+2*
00240      &          X3*V1-2*U3*Y3-3*U4*Y3-2*U2*Y3-2*U1*Y3))
00241       A12(IELEM) = ((X2*KKY-X3*KKY+KKX*Y3-KKX*Y2)*(2*X3*V3+3*X3*V4+
00242      &          2*X3*V2+2*X3*V1-2*U3*Y3-3*U4*Y3-2*U2*Y3-2*U1*Y3))
00243       A21(IELEM) = ((2*X2*V3+3*X2*V4+2*X2*V2+2*X2*V1-2*X3*V3-
00244      &          3*X3*V4-2*X3*V2-2*X3*V1+2*U3*Y3-2*U3*Y2+3*U4*Y3-3*
00245      &          U4*Y2+2*U2*Y3-2*U2*Y2+2*U1*Y3-2*U1*Y2)*(X3*KKY-KKX*Y3))
00246 !
00247 !  USES HERE THE 'MAGIC SQUARE' PROPERTIES OF A DIFFUSION-LIKE MATRIX
00248 !  (SUM OF EACH LINE AND EACH COLUMN IS 0)
00249 !
00250       A13(IELEM) = - A11(IELEM) - A12(IELEM)
00251       A23(IELEM) = - A22(IELEM) - A21(IELEM)
00252       A31(IELEM) = - A11(IELEM) - A21(IELEM)
00253       A32(IELEM) = - A22(IELEM) - A12(IELEM)
00254       A33(IELEM) = - A13(IELEM) - A23(IELEM)
00255 !
00256       ENDDO ! IELEM
00257 !     OTHER TYPES OF FUNCTIONS F AND G
00258 !
00259 !-----------------------------------------------------------------------
00260 !
00261       ELSE
00262 !
00263         IF (LNG.EQ.1) WRITE(LU,100) IELMF,SF%NAME
00264         IF (LNG.EQ.1) WRITE(LU,110) IELMG,SG%NAME
00265         IF (LNG.EQ.1) WRITE(LU,200) IELMU,SU%NAME
00266         IF (LNG.EQ.1) WRITE(LU,300)
00267         IF (LNG.EQ.2) WRITE(LU,101) IELMF,SF%NAME
00268         IF (LNG.EQ.2) WRITE(LU,111) IELMG,SG%NAME
00269         IF (LNG.EQ.2) WRITE(LU,201) IELMU,SU%NAME
00270         IF (LNG.EQ.2) WRITE(LU,301)
00271 100     FORMAT(1X,'MT03AA (BIEF) :',/,
00272      &         1X,'DISCRETISATION DE F : ',1I6,
00273      &         1X,'NOM REEL : ',A6)
00274 110     FORMAT(1X,'DISCRETISATION DE G : ',1I6,
00275      &         1X,'NOM REEL : ',A6)
00276 200     FORMAT(1X,'DISCRETISATION DE U : ',1I6,
00277      &         1X,'NOM REEL : ',A6)
00278 300     FORMAT(1X,'CAS NON PREVU')
00279 101     FORMAT(1X,'MT03AA (BIEF) :',/,
00280      &         1X,'DISCRETIZATION OF F:',1I6,
00281      &         1X,'REAL NAME: ',A6)
00282 111     FORMAT(1X,'DISCRETIZATION OF G:',1I6,
00283      &         1X,'REAL NAME: ',A6)
00284 201     FORMAT(1X,'DISCRETIZATION OF U:',1I6,
00285      &         1X,'REAL NAME: ',A6)
00286 301     FORMAT(1X,'CASE NOT IMPLEMENTED')
00287         CALL PLANTE(0)
00288         STOP
00289 !
00290       ENDIF
00291 !
00292 !-----------------------------------------------------------------------
00293 !
00294       RETURN
00295       END

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