mt06pp.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mt06pp.f
00002 !
00077                      SUBROUTINE MT06PP
00078 !                    *****************
00079 !
00080      &( T,XM,XMUL,SF,F,Z,SURFAC,IKLE,NELEM,NELMAX)
00081 !
00082 !***********************************************************************
00083 ! BIEF   V6P1                                   21/08/2010
00084 !***********************************************************************
00085 !
00086 !
00087 !
00088 !
00089 !
00090 !
00091 !
00092 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00093 !| F              |-->| FUNCTION USED IN THE FORMULA
00094 !| FORMUL         |-->| FORMULA DESCRIBING THE RESULTING MATRIX
00095 !| IKLE           |-->| CONNECTIVITY TABLE.
00096 !| NELEM          |-->| NUMBER OF ELEMENTS
00097 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00098 !| SF             |-->| STRUCTURE OF FUNCTIONS F
00099 !| SURFAC         |-->| AREA OF 2D ELEMENTS
00100 !| T              |<->| WORK ARRAY FOR ELEMENT BY ELEMENT DIAGONAL
00101 !| Z              |-->| ELEVATIONS OF POINTS
00102 !| XM             |<->| OFF-DIAGONAL TERMS
00103 !| XMUL           |-->| COEFFICIENT FOR MULTIPLICATION
00104 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00105 !
00106       USE BIEF, EX_MT06PP => MT06PP
00107       IMPLICIT NONE
00108 !
00109       INTEGER LNG,LU
00110       COMMON/INFO/LNG,LU
00111 !
00112 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00113 !
00114       INTEGER, INTENT(IN) :: NELEM,NELMAX
00115       INTEGER, INTENT(IN) :: IKLE(NELMAX,6)
00116 !
00117       DOUBLE PRECISION, INTENT(INOUT) :: T(NELMAX,6), XM(NELMAX,30)
00118       DOUBLE PRECISION, INTENT(IN) :: XMUL
00119 !
00120       DOUBLE PRECISION, INTENT(IN) :: F(*)
00121 !
00122 !     STRUCTURE OF F
00123 !
00124       TYPE(BIEF_OBJ), INTENT(IN) :: SF
00125 !
00126       DOUBLE PRECISION, INTENT(IN) :: Z(*)
00127       DOUBLE PRECISION, INTENT(IN) :: SURFAC(NELMAX)
00128 !
00129 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00130 !
00131 !     DECLARATIONS SPECIFIC TO THIS SUBROUTINE
00132 !
00133       DOUBLE PRECISION SUR2160,COEF,H1,H2,H3,F1,F2,F3,F4,F5,F6
00134 !
00135       INTEGER IELEM,IELMF
00136 !
00137 !-----------------------------------------------------------------------
00138 !
00139       SUR2160 = XMUL / 2160.D0
00140 !
00141 !-----------------------------------------------------------------------
00142 !
00143       IELMF=SF%ELM
00144       IF(IELMF.NE.41) THEN
00145         IF (LNG.EQ.1) WRITE(LU,100) IELMF
00146         IF (LNG.EQ.2) WRITE(LU,101) IELMF
00147 100     FORMAT(1X,'MT06PP (BIEF) :',/,
00148      &         1X,'DISCRETISATION DE F : ',1I6,' NON PREVUE')
00149 101     FORMAT(1X,'MT06PP (BIEF) :',/,
00150      &         1X,'DISCRETIZATION OF F : ',1I6,' NOT AVAILABLE')
00151         CALL PLANTE(1)
00152         STOP
00153       ENDIF
00154 !
00155 !-----------------------------------------------------------------------
00156 !
00157 ! LOOP ON THE ELEMENTS
00158 !
00159       DO IELEM = 1,NELEM
00160 !
00161         COEF = SURFAC(IELEM)* SUR2160
00162 !
00163         H1 = (Z(IKLE(IELEM,4)) - Z(IKLE(IELEM,1))) * COEF
00164         H2 = (Z(IKLE(IELEM,5)) - Z(IKLE(IELEM,2))) * COEF
00165         H3 = (Z(IKLE(IELEM,6)) - Z(IKLE(IELEM,3))) * COEF
00166 !
00167         F1 = F(IKLE(IELEM,1))
00168         F2 = F(IKLE(IELEM,2))
00169         F3 = F(IKLE(IELEM,3))
00170         F4 = F(IKLE(IELEM,4))
00171         F5 = F(IKLE(IELEM,5))
00172         F6 = F(IKLE(IELEM,6))
00173 !
00174 !-----------------------------------------------------------------------
00175 !
00176 !  EXTRA-DIAGONAL TERMS
00177 !
00178         XM(IELEM,01) =
00179      &     (9*F1+6*F2+3*F3+3*F4+2*F5+F6)*H1+
00180      &     (6*F1+9*F2+3*F3+2*F4+3*F5+F6)*H2+
00181      &     (3*F1+3*F2+3*F3+F4+F5+F6)*H3
00182         XM(IELEM,02) =
00183      &     (9*F1+3*F2+6*F3+3*F4+F5+2*F6)*H1+
00184      &     (3*F1+3*F2+3*F3+F4+F5+F6)*H2+
00185      &     (6*F1+3*F2+9*F3+2*F4+F5+3*F6)*H3
00186         XM(IELEM,03) =
00187      &     (12*F1+3*F2+3*F3+12*F4+3*F5+3*F6)*H1+
00188      &     (3*F1+2*F2+F3+3*F4+2*F5+F6)*H2+
00189      &     (3*F1+F2+2*F3+3*F4+F5+2*F6)*H3
00190         XM(IELEM,04) =
00191      &     (3*F1+2*F2+F3+3*F4+2*F5+F6)*H1+
00192      &     (2*F1+3*F2+F3+2*F4+3*F5+F6)*H2+
00193      &     (F1+F2+F3+F4+F5+F6)*H3
00194         XM(IELEM,05) =
00195      &     (3*F1+F2+2*F3+3*F4+F5+2*F6)*H1+
00196      &     (F1+F2+F3+F4+F5+F6)*H2+
00197      &     (2*F1+F2+3*F3+2*F4+F5+3*F6)*H3
00198         XM(IELEM,06) =
00199      &     (3*F1+3*F2+3*F3+F4+F5+F6)*H1+
00200      &     (3*F1+9*F2+6*F3+F4+3*F5+2*F6)*H2+
00201      &     (3*F1+6*F2+9*F3+F4+2*F5+3*F6)*H3
00202         XM(IELEM,07) =
00203      &     (3*F1+2*F2+F3+3*F4+2*F5+F6)*H1+
00204      &     (2*F1+3*F2+F3+2*F4+3*F5+F6)*H2+
00205      &     (F1+F2+F3+F4+F5+F6)*H3
00206         XM(IELEM,08) =
00207      &     (2*F1+3*F2+F3+2*F4+3*F5+F6)*H1+
00208      &     (3*F1+12*F2+3*F3+3*F4+12*F5+3*F6)*H2+
00209      &     (F1+3*F2+2*F3+F4+3*F5+2*F6)*H3
00210         XM(IELEM,09) =
00211      &     (F1+F2+F3+F4+F5+F6)*H1+
00212      &     (F1+3*F2+2*F3+F4+3*F5+2*F6)*H2+
00213      &     (F1+2*F2+3*F3+F4+2*F5+3*F6)*H3
00214         XM(IELEM,10) =
00215      &     (3*F1+F2+2*F3+3*F4+F5+2*F6)*H1+
00216      &     (F1+F2+F3+F4+F5+F6)*H2+
00217      &     (2*F1+F2+3*F3+2*F4+F5+3*F6)*H3
00218         XM(IELEM,11) =
00219      &     (F1+F2+F3+F4+F5+F6)*H1+
00220      &     (F1+3*F2+2*F3+F4+3*F5+2*F6)*H2+
00221      &     (F1+2*F2+3*F3+F4+2*F5+3*F6)*H3
00222         XM(IELEM,12) =
00223      &     (2*F1+F2+3*F3+2*F4+F5+3*F6)*H1+
00224      &     (F1+2*F2+3*F3+F4+2*F5+3*F6)*H2+
00225      &     (3*F1+3*F2+12*F3+3*F4+3*F5+12*F6)*H3
00226         XM(IELEM,13) =
00227      &     (3*F1+2*F2+F3+9*F4+6*F5+3*F6)*H1+
00228      &     (2*F1+3*F2+F3+6*F4+9*F5+3*F6)*H2+
00229      &     (F1+F2+F3+3*F4+3*F5+3*F6)*H3
00230         XM(IELEM,14) =
00231      &     (3*F1+F2+2*F3+9*F4+3*F5+6*F6)*H1+
00232      &     (F1+F2+F3+3*F4+3*F5+3*F6)*H2+
00233      &     (2*F1+F2+3*F3+6*F4+3*F5+9*F6)*H3
00234         XM(IELEM,15) =
00235      &     (F1+F2+F3+3*F4+3*F5+3*F6)*H1+
00236      &     (F1+3*F2+2*F3+3*F4+9*F5+6*F6)*H2+
00237      &     (F1+2*F2+3*F3+3*F4+6*F5+9*F6)*H3
00238 !
00239 !  DIAGONAL TERMS
00240 !
00241         T(IELEM,1) =
00242      &     (36*F1+9*F2+9*F3+12*F4+3*F5+3*F6)*H1+
00243      &     (9*F1+6*F2+3*F3+3*F4+2*F5+F6)*H2+
00244      &     (9*F1+3*F2+6*F3+3*F4+F5+2*F6)*H3
00245         T(IELEM,2) =
00246      &     (6*F1+9*F2+3*F3+2*F4+3*F5+F6)*H1+
00247      &     (9*F1+36*F2+9*F3+3*F4+12*F5+3*F6)*H2+
00248      &     (3*F1+9*F2+6*F3+F4+3*F5+2*F6)*H3
00249         T(IELEM,3) =
00250      &     (6*F1+3*F2+9*F3+2*F4+F5+3*F6)*H1+
00251      &     (3*F1+6*F2+9*F3+F4+2*F5+3*F6)*H2+
00252      &     (9*F1+9*F2+36*F3+3*F4+3*F5+12*F6)*H3
00253         T(IELEM,4) =
00254      &     (12*F1+3*F2+3*F3+36*F4+9*F5+9*F6)*H1+
00255      &     (3*F1+2*F2+F3+9*F4+6*F5+3*F6)*H2+
00256      &     (3*F1+F2+2*F3+9*F4+3*F5+6*F6)*H3
00257         T(IELEM,5) =
00258      &     (2*F1+3*F2+F3+6*F4+9*F5+3*F6)*H1+
00259      &     (3*F1+12*F2+3*F3+9*F4+36*F5+9*F6)*H2+
00260      &     (F1+3*F2+2*F3+3*F4+9*F5+6*F6)*H3
00261         T(IELEM,6) =
00262      &     (2*F1+F2+3*F3+6*F4+3*F5+9*F6)*H1+
00263      &     (F1+2*F2+3*F3+3*F4+6*F5+9*F6)*H2+
00264      &     (3*F1+3*F2+12*F3+9*F4+9*F5+36*F6)*H3
00265 !
00266       ENDDO
00267 !
00268 !-----------------------------------------------------------------------
00269 !
00270       RETURN
00271       END

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