mt02aa_2.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mt02aa_2.f
00002 !
00064                      SUBROUTINE MT02AA_2
00065 !                    *******************
00066 !
00067      &( A11 , A12 , A13 ,
00068      &        A22 , A23 ,
00069      &              A33 ,
00070      &  XMUL,SU,SV,U,V,
00071      &  XEL,YEL,SURFAC,NELEM,NELMAX)
00072 !
00073 !***********************************************************************
00074 ! BIEF   V7P0                                   21/08/2010
00075 !***********************************************************************
00076 !
00077 !
00078 !
00079 !
00080 !
00081 !
00082 !
00083 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00084 !| A11            |<--| ELEMENTS OF MATRIX
00085 !| A12            |<--| ELEMENTS OF MATRIX
00086 !| A13            |<--| ELEMENTS OF MATRIX
00087 !| A22            |<--| ELEMENTS OF MATRIX
00088 !| A23            |<--| ELEMENTS OF MATRIX
00089 !| A33            |<--| ELEMENTS OF MATRIX
00090 !| NELEM          |-->| NUMBER OF ELEMENTS
00091 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00092 !| SU             |-->| BIEF_OBJ STRUCTURE OF U
00093 !| SURFAC         |-->| AREA OF TRIANGLES
00094 !| SV             |-->| BIEF_OBJ STRUCTURE OF V
00095 !| U              |-->| FUNCTION U USED IN THE FORMULA
00096 !| V              |-->| FUNCTION V USED IN THE FORMULA
00097 !| XEL            |-->| ABSCISSAE OF POINTS IN THE MESH, PER ELEMENT
00098 !| YEL            |-->| ORDINATES OF POINTS IN THE MESH, PER ELEMENT
00099 !| XMUL           |-->| MULTIPLICATION FACTOR
00100 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00101 !
00102       USE BIEF, EX_MT02AA_2 => MT02AA_2
00103 !
00104       IMPLICIT NONE
00105       INTEGER LNG,LU
00106       COMMON/INFO/LNG,LU
00107 !
00108 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00109 !
00110       INTEGER, INTENT(IN) :: NELEM,NELMAX
00111       DOUBLE PRECISION, INTENT(INOUT) :: A11(*),A12(*),A13(*)
00112       DOUBLE PRECISION, INTENT(INOUT) ::        A22(*),A23(*)
00113       DOUBLE PRECISION, INTENT(INOUT) ::               A33(*)
00114       DOUBLE PRECISION, INTENT(IN) :: XMUL
00115       DOUBLE PRECISION, INTENT(IN) :: U(*),V(*)
00116 !     STRUCTURE OF U AND V
00117       TYPE(BIEF_OBJ)  , INTENT(IN) :: SU,SV
00118       DOUBLE PRECISION, INTENT(IN) :: XEL(NELMAX,3),YEL(NELMAX,3)
00119       DOUBLE PRECISION, INTENT(IN) :: SURFAC(NELMAX)
00120 !
00121 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00122 !
00123 !     DECLARATIONS SPECIFIC TO THIS SUBROUTINE
00124 !
00125       INTEGER IELEM,IELMNU,IELMNV
00126 !
00127       DOUBLE PRECISION X2,X3,Y2,Y3,KSAT1,KSAT2,KSAT3,SOM,XSUR12
00128 !
00129 !=======================================================================
00130 !
00131 !     EXTRACTS THE TYPE OF ELEMENT FOR VISCOSITY
00132 !
00133       IELMNU = SU%ELM
00134       IELMNV = SV%ELM
00135 !
00136       XSUR12 = XMUL / 12.D0
00137 !
00138 !-----------------------------------------------------------------------
00139 ! TESTS THE TYPES OF U AND V
00140 ! U (KR) : P0 AND DIM 3 (BECAUSE DISCONTINUOUS P1) - V (KS) : P0 AND DIM 3
00141 !-----------------------------------------------------------------------
00142 !
00143       IF(IELMNU.EQ.15.AND.IELMNV.EQ.15) THEN
00144 !
00145       DO IELEM = 1 , NELEM
00146 !
00147 ! THE 3 TERMS OF MATRIX V (KS IS SYMMETRICAL)
00148 !
00149         KSAT1=SV%R(IELEM)
00150         KSAT2=SV%R(IELEM+NELEM)
00151         KSAT3=SV%R(IELEM+2*NELEM)
00152 !
00153 !   INITIALISES THE GEOMETRICAL VARIABLES
00154 !
00155         X2  =  XEL(IELEM,2)
00156         X3  =  XEL(IELEM,3)
00157 !
00158         Y2  =  YEL(IELEM,2)
00159         Y3  =  YEL(IELEM,3)
00160 !
00161 !   INITIALISES THE INTERMEDIATE VARIABLES
00162 !
00163         SOM = ( SU%R(IELEM+2*NELEM)
00164      &      +   SU%R(IELEM+NELEM)
00165      &      +   SU%R(IELEM) ) * XSUR12 / SURFAC(IELEM)
00166 !
00167 !  DIAGONAL TERMS
00168 !
00169         A11(IELEM) = (KSAT1*Y2**2-2*KSAT1*Y2*Y3+KSAT1*Y3**2+KSAT2*X2**2-
00170      &  2*KSAT2*X2*X3+KSAT2*X3**2-2*KSAT3*Y2*X2+2*KSAT3*Y2*X3+
00171      &  2*KSAT3*X2*Y3-2*KSAT3*Y3*X3)*SOM
00172 !
00173         A22(IELEM) = (KSAT1*Y3**2+KSAT2*X3**2-2*KSAT3*Y3*X3)*SOM
00174 !
00175         A33(IELEM) = (KSAT1*Y2**2+KSAT2*X2**2-2*KSAT3*Y2*X2)*SOM
00176 !
00177 !  EXTRADIAGONAL TERMS
00178 !
00179         A12(IELEM) = -(-KSAT1*Y2*Y3+KSAT1*Y3**2-KSAT2*X2*X3+KSAT2*X3**2+
00180      &          KSAT3*X2*Y3-2*KSAT3*Y3*X3+KSAT3*Y2*X3)*SOM
00181 !
00182         A13(IELEM) = -(KSAT1*Y2**2-KSAT1*Y2*Y3+KSAT2*X2**2-KSAT2*X2*X3-
00183      &          2*KSAT3*Y2*X2+KSAT3*Y2*X3+KSAT3*X2*Y3)*SOM
00184 !
00185         A23(IELEM) = (-KSAT1*Y2*Y3-KSAT2*X2*X3+KSAT3*Y2*X3+KSAT3*X2*Y3)*
00186      &          SOM
00187 !
00188 !   END OF THE LOOP ON THE ELEMENTS
00189 !
00190       ENDDO
00191 !
00192 !-----------------------------------------------------------------------
00193 !
00194       ELSE
00195 !
00196         IF (LNG.EQ.1) WRITE(LU,10)
00197         IF (LNG.EQ.2) WRITE(LU,11)
00198 10      FORMAT(1X,'MT02AA_2 (BIEF) : TYPES NON PREVUS')
00199 11      FORMAT(1X,'MT02AA_2 (BIEF) : TYPES NOT AVAILABLE')
00200         CALL PLANTE(1)
00201         STOP
00202 !
00203       ENDIF
00204 !
00205 !-----------------------------------------------------------------------
00206 !
00207       RETURN
00208       END

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