mt06cc.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mt06cc.f
00002 !
00065                      SUBROUTINE MT06CC
00066 !                    *****************
00067 !
00068      &( A11 , A12 , A13 , A14 , A15 , A16 ,
00069      &        A22 , A23 , A24 , A25 , A26 ,
00070      &              A33 , A34 , A35 , A36 ,
00071      &                    A44 , A45 , A46 ,
00072      &                          A55 , A56 ,
00073      &                                A66 ,
00074      &  XMUL,SF,F,SURFAC,
00075      &  IKLE1,IKLE2,IKLE3,IKLE4,IKLE5,IKLE6,NELEM,NELMAX)
00076 !
00077 !***********************************************************************
00078 ! BIEF   V6P1                                   21/08/2010
00079 !***********************************************************************
00080 !
00081 !
00082 !
00083 !
00084 !
00085 !
00086 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00087 !| A11            |<--| ELEMENTS OF MATRIX
00088 !| ...            |<--| ELEMENTS OF MATRIX
00089 !| A66            |<--| ELEMENTS OF MATRIX
00090 !| F              |-->| FUNCTION F USED IN THE FORMULA
00091 !| IKLE1          |-->| FIRST POINTS OF TRIANGLES
00092 !| IKLE2          |-->| SECOND POINTS OF TRIANGLES
00093 !| IKLE3          |-->| THIRD POINTS OF TRIANGLES
00094 !| IKLE4          |-->| FOURTH POINTS OF TRIANGLES (QUADRATIC)
00095 !| IKLE5          |-->| FIFTH POINTS OF TRIANGLES (QUADRATIC)
00096 !| IKLE6          |-->| SIXTH POINTS OF TRIANGLES (QUADRATIC)
00097 !| NELEM          |-->| NUMBER OF ELEMENTS
00098 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00099 !| SF             |-->| BIEF_OBJ STRUCTURE OF F
00100 !| SURFAC         |-->| AREA OF TRIANGLES
00101 !| XMUL           |-->| MULTIPLICATION FACTOR
00102 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00103 !
00104       USE BIEF!, EX_MT06CC => MT06CC
00105 !
00106       IMPLICIT NONE
00107       INTEGER LNG,LU
00108       COMMON/INFO/LNG,LU
00109 !
00110 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00111 !
00112       INTEGER, INTENT(IN) :: NELEM,NELMAX
00113       INTEGER, INTENT(IN) :: IKLE1(NELMAX),IKLE2(NELMAX)
00114       INTEGER, INTENT(IN) :: IKLE3(NELMAX),IKLE4(NELMAX)
00115       INTEGER, INTENT(IN) :: IKLE5(NELMAX),IKLE6(NELMAX)
00116 !
00117       DOUBLE PRECISION, INTENT(INOUT) :: A11(*),A12(*),A13(*)
00118       DOUBLE PRECISION, INTENT(INOUT) :: A14(*),A15(*),A16(*)
00119       DOUBLE PRECISION, INTENT(INOUT) ::        A22(*),A23(*)
00120       DOUBLE PRECISION, INTENT(INOUT) :: A24(*),A25(*),A26(*)
00121       DOUBLE PRECISION, INTENT(INOUT) ::               A33(*)
00122       DOUBLE PRECISION, INTENT(INOUT) :: A34(*),A35(*),A36(*)
00123       DOUBLE PRECISION, INTENT(INOUT) :: A44(*),A45(*),A46(*)
00124       DOUBLE PRECISION, INTENT(INOUT) ::        A55(*),A56(*)
00125       DOUBLE PRECISION, INTENT(INOUT) ::               A66(*)
00126 !
00127       DOUBLE PRECISION, INTENT(IN) :: XMUL
00128       DOUBLE PRECISION, INTENT(IN) :: F(*)
00129 !
00130 !     STRUCTURE OF F
00131       TYPE(BIEF_OBJ), INTENT(IN) :: SF
00132 !
00133       DOUBLE PRECISION, INTENT(IN) :: SURFAC(NELMAX)
00134 !
00135 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00136 !
00137 !     DECLARATIONS SPECIFIC TO THIS SUBROUTINE
00138 !
00139       DOUBLE PRECISION F1,F2,F3,F4,F5,F6,XSUR030,XSUR045,XSUR180
00140       DOUBLE PRECISION XSUR315,XSUR210,XSUR630,XSU1260
00141       DOUBLE PRECISION AUX315,AUX210,AUX630,AUX1260
00142       INTEGER IELMF,IELEM
00143 !
00144 !=======================================================================
00145 !
00146 !     EXTRACTS THE TYPE OF ELEMENT FOR F
00147 !
00148       IELMF = SF%ELM
00149 !
00150 !  CASE WHERE F IS P0
00151 !
00152       IF(IELMF.EQ.10) THEN
00153 !
00154       XSUR030 = XMUL / 30.D0
00155       XSUR045 = XMUL / 45.D0
00156       XSUR180 = XMUL /180.D0
00157 !
00158       DO IELEM = 1 , NELEM
00159 !
00160 !   INITIALISES THE GEOMETRICAL VARIABLES
00161 !
00162         F1  =  F(IELEM) * SURFAC(IELEM)
00163 !
00164 !  DIAGONAL TERMS
00165 !
00166         A11(IELEM) =   XSUR030 * F1
00167         A22(IELEM) =   A11(IELEM)
00168         A33(IELEM) =   A11(IELEM)
00169         A44(IELEM) =   8.D0 * XSUR045 * F1
00170         A55(IELEM) =   A44(IELEM)
00171         A66(IELEM) =   A44(IELEM)
00172 !
00173 !  EXTRADIAGONAL TERMS
00174 !
00175         A12(IELEM) = - XSUR180 * F1
00176         A13(IELEM) =   A12(IELEM)
00177         A14(IELEM) =   0.D0
00178         A15(IELEM) = - XSUR045*F1
00179         A16(IELEM) =   0.D0
00180 !
00181         A23(IELEM) =   A12(IELEM)
00182         A24(IELEM) =   0.D0
00183         A25(IELEM) =   0.D0
00184         A26(IELEM) =   A15(IELEM)
00185 !
00186         A34(IELEM) =   A15(IELEM)
00187         A35(IELEM) =   0.D0
00188         A36(IELEM) =   0.D0
00189 !
00190         A45(IELEM) =   4.D0*XSUR045*F1
00191         A46(IELEM) =   A45(IELEM)
00192 !
00193         A56(IELEM) =   A45(IELEM)
00194 !
00195       ENDDO ! IELEM
00196 !
00197 !-----------------------------------------------------------------------
00198 !
00199 !  CASE WHERE F IS LINEAR
00200 !
00201       ELSEIF(IELMF.EQ.11) THEN
00202 !
00203       XSUR210 = XMUL /  210.D0
00204       XSUR315 = XMUL /  315.D0
00205       XSU1260 = XMUL / 1260.D0
00206 !
00207       DO IELEM = 1 , NELEM
00208         AUX210 = SURFAC(IELEM) * XSUR210
00209         AUX315 = SURFAC(IELEM) * XSUR315
00210         AUX1260= SURFAC(IELEM) * XSU1260
00211 !
00212 !   INITIALISES THE GEOMETRICAL VARIABLES
00213 !
00214         F1  =  F(IKLE1(IELEM))
00215         F2  =  F(IKLE2(IELEM))
00216         F3  =  F(IKLE3(IELEM))
00217 !
00218 !   INITIALISES THE INTERMEDIATE VARIABLES
00219 !
00220 !
00221 !  DIAGONAL TERMS
00222 !
00223         A11(IELEM) =      (5.D0*F1+     F2+     F3)*AUX210
00224         A22(IELEM) =      (     F1+5.D0*F2+     F3)*AUX210
00225         A33(IELEM) =      (     F1+     F2+5.D0*F3)*AUX210
00226         A44(IELEM) = 8.D0*(3.D0*F1+3.D0*F2+     F3)*AUX315
00227         A55(IELEM) = 8.D0*(     F1+3.D0*F2+3.D0*F3)*AUX315
00228         A66(IELEM) = 8.D0*(3.D0*F1+     F2+3.D0*F3)*AUX315
00229 !
00230 !  EXTRADIAGONAL TERMS
00231 !
00232         A12(IELEM) = -(4.D0*F1+4.D0*F2-     F3)*AUX1260
00233         A13(IELEM) = -(4.D0*F1-     F2+4.D0*F3)*AUX1260
00234         A14(IELEM) =  (3.D0*F1-2.D0*F2-     F3)*AUX315
00235         A15(IELEM) = -(     F1+3.D0*F2+3.D0*F3)*AUX315
00236         A16(IELEM) =  (3.D0*F1-     F2-2.D0*F3)*AUX315
00237 !
00238         A23(IELEM) =  (     F1-4.D0*F2-4.D0*F3)*AUX1260
00239         A24(IELEM) = -(2.D0*F1-3.D0*F2+     F3)*AUX315
00240         A25(IELEM) = -(     F1-3.D0*F2+2.D0*F3)*AUX315
00241         A26(IELEM) = -(3.D0*F1+     F2+3.D0*F3)*AUX315
00242 !
00243         A34(IELEM) = -(3.D0*F1+3.D0*F2+     F3)*AUX315
00244         A35(IELEM) = -(     F1+2.D0*F2-3.D0*F3)*AUX315
00245         A36(IELEM) = -(2.D0*F1+     F2-3.D0*F3)*AUX315
00246 !
00247         A45(IELEM) =  (2.D0*F1+3.D0*F2+2.D0*F3)*AUX315*4.D0
00248         A46(IELEM) =  (3.D0*F1+2.D0*F2+2.D0*F3)*AUX315*4.D0
00249 !
00250         A56(IELEM) =  (2.D0*F1+3.D0*F3+2.D0*F2)*AUX315*4.D0
00251 !
00252       ENDDO ! IELEM
00253 !
00254 !-----------------------------------------------------------------------
00255 !
00256       ELSEIF(IELMF.EQ.13) THEN
00257 !
00258 !-----------------------------------------------------------------------
00259 !
00260 !   QUADRATIC DISCRETISATION OF F:
00261 !
00262       XSUR315 = XMUL /  315.D0
00263       XSUR630 = XMUL /  630.D0
00264       XSU1260 = XMUL / 1260.D0
00265 !
00266       DO IELEM = 1 , NELEM
00267         AUX315 = SURFAC(IELEM) * XSUR315
00268         AUX630 = SURFAC(IELEM) * XSUR630
00269         AUX1260= SURFAC(IELEM) * XSU1260
00270 !
00271 !   INITIALISES THE GEOMETRICAL VARIABLES
00272 !
00273         F1  =  F(IKLE1(IELEM))
00274         F2  =  F(IKLE2(IELEM))
00275         F3  =  F(IKLE3(IELEM))
00276         F4  =  F(IKLE4(IELEM))
00277         F5  =  F(IKLE5(IELEM))
00278         F6  =  F(IKLE6(IELEM))
00279 !
00280 !  DIAGONAL TERMS
00281 !
00282         A11(IELEM) = (6.D0*(F4+F6)+9.D0*F1+2.D0*F5-F2-F3) * AUX630
00283         A22(IELEM) = (6.D0*(F4+F5)+2.D0*F6+9.D0*F2-F1-F3) * AUX630
00284         A33(IELEM) = (6.D0*(F6+F5)+9.D0*F3+2.D0*F4-F1-F2) * AUX630
00285         A44(IELEM) =  4.D0*(3.D0*(F6+F5)+9.D0*F4-F3) * AUX315
00286         A55(IELEM) =  4.D0*(3.D0*(F4+F6)+9.D0*F5-F1) * AUX315
00287         A66(IELEM) =  4.D0*(3.D0*(F4+F5)+9.D0*F6-F2) * AUX315
00288 !
00289 !  EXTRADIAGONAL TERMS
00290 !
00291         A12(IELEM) = -(2.D0*(F1+F2)+4.D0*F4-F3) * AUX1260
00292         A13(IELEM) = -(2.D0*(F1+F3)+4.D0*F6-F2) * AUX1260
00293         A14(IELEM) =  (3.D0* F1    -2.D0*F5-F2) * AUX315
00294         A15(IELEM) = -(2.D0*(F4+F6)+4.D0*F5-F1) * AUX315
00295         A16(IELEM) =  (3.D0*F1     -2.D0*F5-F3) * AUX315
00296 !
00297         A23(IELEM) =  (-2.D0*(F2+F3)-4.D0*F5+F1) * AUX1260
00298         A24(IELEM) =  (-2.D0*F6     +3.D0*F2-F1) * AUX315
00299         A25(IELEM) =  (-2.D0*F6     +3.D0*F2-F3) * AUX315
00300         A26(IELEM) =  (-2.D0*(F4+F5)-4.D0*F6+F2) * AUX315
00301 !
00302         A34(IELEM) =  (-2.D0*(F6+F5)-4.D0*F4+F3) * AUX315
00303         A35(IELEM) =  (-2.D0*F4     +3.D0*F3-F2) * AUX315
00304         A36(IELEM) =  (-2.D0*F4     +3.D0*F3-F1) * AUX315
00305 !
00306         A45(IELEM) =  2.D0*(6.D0*(F4+F5)+4.D0*F6-F1-F3) * AUX315
00307         A46(IELEM) =  2.D0*(6.D0*(F4+F6)+4.D0*F5-F2-F3) * AUX315
00308 !
00309         A56(IELEM) =  2.D0*(6.D0*(F6+F5)+4.D0*F4-F2-F1) * AUX315
00310 !
00311       ENDDO ! IELEM
00312 !
00313       ELSE
00314 !
00315         IF (LNG.EQ.1) WRITE(LU,100) IELMF,SF%NAME
00316         IF (LNG.EQ.2) WRITE(LU,101) IELMF,SF%NAME
00317 100     FORMAT(1X,'MT06CC (BIEF) :',/,
00318      &         1X,'DISCRETISATION DE F NON PREVUE : ',1I6,
00319      &         1X,'NOM REEL : ',A6)
00320 101     FORMAT(1X,'MT06CC (BIEF) :',/,
00321      &         1X,'DISCRETIZATION OF F NOT AVAILABLE:',1I6,
00322      &         1X,'REAL NAME: ',A6)
00323         CALL PLANTE(1)
00324         STOP
00325 !
00326       ENDIF
00327 !
00328 !-----------------------------------------------------------------------
00329 !
00330       RETURN
00331       END

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