mt09oo.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mt09oo.f
00002 !
00065                      SUBROUTINE MT09OO
00066 !                    *****************
00067 !
00068      &(A11,A12,A21,A22,XMUL,SF,F,SG,G,SU,SV,U,V,
00069      & IKLE1,IKLE2,NBOR,NELEM,NELMAX)
00070 !
00071 !***********************************************************************
00072 ! BIEF   V6P3                                   21/08/2010
00073 !***********************************************************************
00074 !
00075 !
00076 !
00077 !
00078 !
00079 !
00080 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00081 !| A11            |<--| ELEMENTS OF MATRIX
00082 !| A12            |<--| ELEMENTS OF MATRIX
00083 !| A13            |<--| ELEMENTS OF MATRIX
00084 !| A22            |<--| ELEMENTS OF MATRIX
00085 !| A23            |<--| ELEMENTS OF MATRIX
00086 !| A33            |<--| ELEMENTS OF MATRIX
00087 !| F              |-->| FUNCTION F USED IN THE FORMULA
00088 !| IKLE1          |-->| FIRST POINTS OF SEGMENTS
00089 !| IKLE2          |-->| SECOND POINTS OF SEGMENTS
00090 !| NBOR           |-->| GLOBAL NUMBER OF BOUNDARY POINTS
00091 !| NELEM          |-->| NUMBER OF ELEMENTS
00092 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00093 !| SF             |-->| BIEF_OBJ STRUCTURE OF F
00094 !| SURFAC         |-->| AREA OF TRIANGLES
00095 !| XMUL           |-->| MULTIPLICATION FACTOR
00096 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00097 !
00098       USE BIEF
00099 !  EX_MT09OO => MT09OO
00100 !
00101       IMPLICIT NONE
00102       INTEGER LNG,LU
00103       COMMON/INFO/LNG,LU
00104 !
00105 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00106 !
00107       INTEGER, INTENT(IN) :: NELEM,NELMAX
00108       INTEGER, INTENT(IN) :: IKLE1(*),IKLE2(*),NBOR(*)
00109 !
00110       DOUBLE PRECISION, INTENT(IN) :: XMUL,U(*),V(*)
00111 !
00112       DOUBLE PRECISION, INTENT(IN) :: F(*),G(*)
00113 !
00114 !     STRUCTURE OF F
00115       TYPE(BIEF_OBJ), INTENT(IN) :: SF,SG,SU,SV
00116 !
00117       DOUBLE PRECISION, INTENT(INOUT) :: A11(NELMAX)
00118       DOUBLE PRECISION, INTENT(INOUT) :: A12(NELMAX)
00119       DOUBLE PRECISION, INTENT(INOUT) :: A21(NELMAX)
00120       DOUBLE PRECISION, INTENT(INOUT) :: A22(NELMAX)
00121 !
00122 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00123 !
00124       INTEGER IELEM,IELMF
00125       DOUBLE PRECISION SUR24,U1N,U2N,U1,U2,V1,V2
00126       DOUBLE PRECISION TETA1,TETA2
00127 !
00128 !-----------------------------------------------------------------------
00129 !
00130       SUR24  = XMUL/24.D0
00131 !
00132 !-----------------------------------------------------------------------
00133 !
00134       IELMF = SU%ELM
00135 !
00136 !     F LINEAR BY SEGMENT, IN A BOUNDARY ARRAY
00137 !     NOTE: IKLE IS HERE A BOUNDARY IKLE
00138 !
00139       IF (IELMF.EQ.11) THEN
00140 !
00141         DO IELEM = 1 , NELEM
00142 !
00143         U1 = U(NBOR(IKLE1(IELEM)))
00144         U2 = U(NBOR(IKLE2(IELEM)))
00145 !
00146         V1 = V(NBOR(IKLE1(IELEM)))
00147         V2 = V(NBOR(IKLE2(IELEM)))
00148 !
00149         U1N=SQRT(U1**2+V1**2)
00150         U2N=SQRT(U2**2+V2**2)
00151 !
00152         IF(U1N.GT.1.D-5.AND.U2N.GT.1.D-5) THEN
00153 !
00154 !
00155           TETA1= ASIN((U1*F(IELEM)+V1*G(IELEM))/U1N)
00156           TETA2= ASIN((U2*F(IELEM)+V2*G(IELEM))/U2N)
00157 !
00158 !
00159           A11(IELEM) = SUR24*(3.D0*SIN(2*TETA1)*(U1N**2)
00160      &                 +        SIN(2*TETA2)*(U2N**2)
00161      &                 + 2.D0*U1N*U2N*SIN(TETA1+TETA2))
00162           A12(IELEM) = -A11(IELEM)
00163           A21(IELEM) = SUR24*(SIN(2*TETA1)*(U1N**2)
00164      &                 +   3.D0*SIN(2*TETA2)*(U2N**2)
00165      &                 + 2.D0*U1N*U2N*SIN(TETA1+TETA2))
00166           A22(IELEM) = -A21(IELEM)
00167 !
00168 !    SI COURANT NUL
00169 !
00170         ELSE
00171           A11(IELEM) = 0.D0
00172           A12(IELEM) = 0.D0
00173           A21(IELEM) = 0.D0
00174           A22(IELEM) = 0.D0
00175         ENDIF
00176 !
00177       ENDDO
00178 !
00179 !     OTHER TYPES OF DISCRETISATION OF F
00180 !
00181       ELSE
00182 !
00183         IF (LNG.EQ.1) WRITE(LU,100) IELMF,SF%NAME
00184         IF (LNG.EQ.2) WRITE(LU,101) IELMF,SF%NAME
00185 100     FORMAT(1X,'MT0900 (BIEF) :',/,
00186      &         1X,'DISCRETISATION DE F NON PREVUE : ',1I6,
00187      &         1X,'NOM REEL : ',A6)
00188 101     FORMAT(1X,'MT0900 (BIEF) :',/,
00189      &         1X,'DISCRETIZATION OF F NOT AVAILABLE:',1I6,
00190      &         1X,'REAL NAME: ',A6)
00191         CALL PLANTE(1)
00192         STOP
00193 !
00194       ENDIF
00195 !
00196 !-----------------------------------------------------------------------
00197 !
00198       RETURN
00199       END

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