mt02tt.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mt02tt.f
00002 !
00084                      SUBROUTINE MT02TT
00085 !                    *****************
00086 !
00087      &(T,XM,XMUL,SF,SG,SH,F,G,H,X,Y,Z,IKLE,NELEM,NELMAX,INCHYD,NPOIN2)
00088 !
00089 !***********************************************************************
00090 ! BIEF   V6P2                                   21/08/2010
00091 !***********************************************************************
00092 !
00093 !
00094 !
00095 !
00096 !
00097 !
00098 !
00099 !
00100 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00101 !| F              |-->| FUNCTION USED IN THE FORMULA
00102 !| FORMUL         |-->| FORMULA DESCRIBING THE RESULTING MATRIX
00103 !| G              |-->| FUNCTION USED IN THE FORMULA
00104 !| H              |-->| FUNCTION USED IN THE FORMULA
00105 !| IKLE           |-->| CONNECTIVITY TABLE.
00106 !| INCHYD         |-->| IF YES, TREATS HYDROSTATIC INCONSISTENCIES
00107 !| NELEM          |-->| NUMBER OF ELEMENTS
00108 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00109 !| NPLAN          |-->| NUMBER OF PLANES IN THE MESH OF PRISMS
00110 !| NPOIN2         |-->| NUMBER OF POINTS IN UNDERLYING 2D MESH
00111 !|                |   | (CASE OF ELEMENT 51, PRISMS CUT INTO TETRAHEDRA)
00112 !| SF             |-->| STRUCTURE OF FUNCTIONS F
00113 !| SG             |-->| STRUCTURE OF FUNCTIONS G
00114 !| SH             |-->| STRUCTURE OF FUNCTIONS H
00115 !| SURFAC         |-->| AREA OF 2D ELEMENTS
00116 !| T              |<->| WORK ARRAY FOR ELEMENT BY ELEMENT DIAGONAL
00117 !| X              |-->| ABSCISSAE OF POINTS
00118 !| Y              |-->| ORDINATES OF POINTS
00119 !| Z              |-->| ELEVATIONS OF POINTS
00120 !| XM             |<->| OFF-DIAGONAL TERMS
00121 !| XMUL           |-->| COEFFICIENT FOR MULTIPLICATION
00122 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00123 !
00124       USE BIEF, EX_MT02TT => MT02TT
00125 !
00126       IMPLICIT NONE
00127 !
00128       INTEGER LNG,LU
00129       COMMON/INFO/LNG,LU
00130 !
00131 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00132 !
00133       INTEGER, INTENT(IN) :: NELEM,NELMAX,NPOIN2
00134       INTEGER, INTENT(IN) :: IKLE(NELMAX,4)
00135 !
00136       DOUBLE PRECISION, INTENT(INOUT) :: T(NELMAX,4),XM(NELMAX,6)
00137 !
00138       DOUBLE PRECISION, INTENT(IN) :: XMUL
00139       DOUBLE PRECISION, INTENT(IN) :: F(*),G(*),H(*)
00140 !
00141 !     STRUCTURES OF F, G, H
00142 !
00143       TYPE(BIEF_OBJ), INTENT(IN) :: SF,SG,SH
00144 !
00145       DOUBLE PRECISION, INTENT(IN) :: X(*),Y(*),Z(*)
00146 !
00147       LOGICAL, INTENT(IN) :: INCHYD
00148 !
00149 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00150 !
00151 !     SPECIFIC DECLARATIONS
00152 !
00153       DOUBLE PRECISION X2,Y2,Z2,X3,Y3,Z3,X4,Y4,Z4,VOL6
00154       INTEGER I1,I2,I3,I4,IELEM,ISO,IL1,IL2,IL3,IL4,ILOW
00155 !
00156       DOUBLE PRECISION COEF,SUR24,DZ1,DZ2,DZ3,DZ4
00157       DOUBLE PRECISION FTOT,GTOT,HTOT,VTOT,WTOT,FGTOT,GHTOT,FHTOT
00158       DOUBLE PRECISION T1,T3,T5,T7,T9,T11,T13,T15,T17,T19,T21,T23
00159       DOUBLE PRECISION T35,T49,T28,T42,T51,T54
00160       DOUBLE PRECISION AUX,AUXX,AUXXX
00161       DOUBLE PRECISION AUX1,AUX2,AUX3,AUX4,AUX5,AUX6,AUX7,AUX8,AUX9
00162 !
00163       DOUBLE PRECISION EPSI
00164       DATA EPSI/1.D-4/
00165 !
00166 !***********************************************************************
00167 !
00168       SUR24=1.D0/24.D0
00169       ISO = SF%DIM2
00170 !
00171 !     SEE VISCLM OF TELEMAC-3D
00172 !     FOR THE TREATMENT OF P0 VERTICAL VISCOSITY ON THE VERTICAL
00173 !
00174       IF(SH%DIMDISC.EQ.0) THEN
00175 !       P1 VERTICAL VISCOSITY
00176 !       NPOU0=SH%DIM1/NPLAN
00177 !     ELSEIF(SH%DIMDISC.EQ.4111) THEN
00178 !       P0 VERTICAL VISCOSITY ON THE VERTICAL (SEE II4,5,6)
00179 !       NPOU0=0
00180       ELSE
00181         IF (LNG.EQ.1) WRITE(LU,4000) SH%DIMDISC
00182         IF (LNG.EQ.2) WRITE(LU,4001) SH%DIMDISC
00183 4000    FORMAT(1X,'MT02TT (BIEF) : DIMDISC DE H NON PREVU : ',I6)
00184 4001    FORMAT(1X,'MT02TT (BIEF): DIMDISC OF H NOT IMPLEMENTED: ',I6)
00185         CALL PLANTE(1)
00186         STOP
00187       ENDIF
00188 !
00189 !     TRUE TETRAHEDRA
00190 !
00191       IF(SF%ELM.EQ.31.AND.SG%ELM.EQ.31.AND.
00192      &   SH%ELM.EQ.31.AND.ISO.EQ.1) THEN
00193 !
00194 !-----------------------------------------------------------------------
00195 !
00196 !   LINEAR DISCRETISATION OF DIFFUSION COEFFICIENTS
00197 !
00198 !   LOOP ON THE TETRAHEDRONS
00199 !
00200       DO IELEM=1,NELEM
00201 !
00202       I1=IKLE(IELEM,1)
00203       I2=IKLE(IELEM,2)
00204       I3=IKLE(IELEM,3)
00205       I4=IKLE(IELEM,4)
00206 !
00207 !-----------------------------------------------------------------------
00208 !
00209 ! VISCOSITY ALONG X Y AND Z
00210 !
00211       HTOT=F(I1)+F(I2)+F(I3)+F(I4)
00212       VTOT=G(I1)+G(I2)+G(I3)+G(I4)
00213       WTOT=H(I1)+H(I2)+H(I3)+H(I4)
00214 !
00215       X2=X(I2)-X(I1)
00216       Y2=Y(I2)-Y(I1)
00217       Z2=Z(I2)-Z(I1)
00218       X3=X(I3)-X(I1)
00219       Y3=Y(I3)-Y(I1)
00220       Z3=Z(I3)-Z(I1)
00221       X4=X(I4)-X(I1)
00222       Y4=Y(I4)-Y(I1)
00223       Z4=Z(I4)-Z(I1)
00224 !
00225 !-----------------------------------------------------------------------
00226 !    COEF:  THANKS MAPLE...
00227 !-----------------------------------------------------------------------
00228 !
00229       T1  = X2*Y3
00230       T3  = X2*Y4
00231       T5  = X3*Y2
00232       T7  = X4*Y2
00233       T9  = X3*Z2
00234       T11 = X4*Z2
00235 !     T13 = 4 TIMES THE TETRAHEDRON VOLUME ?
00236       T13 = T1*Z4-T3*Z3-T5*Z4+T7*Z3+T9*Y4-T11*Y3
00237 !
00238       T15 = -Y2*Z3+Y3*Z2
00239       T17 =  X2*Z4-T11
00240       T19 = -Y3*Z4+Y4*Z3
00241       T21 =  X2*Z3-T9
00242       T23 = -Y2*Z4+Y4*Z2
00243       T35 =  X3*Z4-X4*Z3
00244       T49 =  X3*Y4-X4*Y3
00245 !
00246 !     BEWARE, PROBLEM WITH TIDAL FLATS HERE
00247 !
00248       COEF=XMUL*SUR24/MAX(T13,1.D-10)
00249 !     COEF=XMUL*SUR24/T13
00250 !
00251       T28 = -T19+T23-T15
00252       T42 = -T35+T17-T21
00253       T51 = T3-T7
00254       T54 = T49-T3+T7+T1-T5
00255 !
00256       T(IELEM,1) =COEF*(HTOT*T28**2+VTOT*T42**2+WTOT*T54**2)
00257       T(IELEM,2) =COEF*(HTOT*T19**2+VTOT*T35**2+WTOT*T49**2)
00258       T(IELEM,3) =COEF*(HTOT*T23**2+VTOT*T17**2+WTOT*T51**2)
00259       XM(IELEM,1)=COEF*(HTOT*T28*T19+VTOT*T42*T35-WTOT*T54*T49)
00260       XM(IELEM,2)=COEF*(-HTOT*T28*T23-VTOT*T42*T17+WTOT*T54*T51)
00261       XM(IELEM,3)=-(XM(IELEM,2)+XM(IELEM,1)+T(IELEM,1))
00262       XM(IELEM,4)=COEF*(-HTOT*T19*T23-VTOT*T35*T17-WTOT*T49*T51)
00263       XM(IELEM,5)= -(XM(IELEM,4)+T(IELEM,2)+XM(IELEM,1))
00264       XM(IELEM,6)= -(T(IELEM,3)+XM(IELEM,4)+XM(IELEM,2))
00265       T(IELEM,4) = -(XM(IELEM,3)+XM(IELEM,5)+XM(IELEM,6))
00266 !
00267 !-----------------------------------------------------------------------
00268 !
00269       ENDDO
00270 !
00271 !     TETRAHEDRA FORMING PRISMS
00272 !
00273       ELSEIF(SF%ELM.EQ.51.AND.SG%ELM.EQ.51.AND.SH%ELM.EQ.51.AND.
00274      &                                                    ISO.EQ.1) THEN
00275 !
00276 !-----------------------------------------------------------------------
00277 !
00278 !   LINEAR DISCRETISATION OF DIFFUSION COEFFICIENTS
00279 !
00280 !   LOOP ON THE TETRAHEDRONS
00281 !
00282       DO IELEM=1,NELEM
00283 !
00284       I1=IKLE(IELEM,1)
00285       I2=IKLE(IELEM,2)
00286       I3=IKLE(IELEM,3)
00287       I4=IKLE(IELEM,4)
00288 !
00289 !-----------------------------------------------------------------------
00290 !
00291 ! VISCOSITY ALONG X, Y, AND Z
00292 !
00293 !     IL1: PLANE NUMBER OF POINT 1 MINUS 1 (0 FOR FIRST PLANE), ETC.
00294       IL1=(I1-1)/NPOIN2
00295       IL2=(I2-1)/NPOIN2
00296       IL3=(I3-1)/NPOIN2
00297       IL4=(I4-1)/NPOIN2
00298 !     RANK OF LOWER PLANE MINUS 1
00299       ILOW=MIN(IL1,IL2,IL3,IL4)
00300 !     NOW IL1=0 IF POINT AT THE BACK OF ORIGINAL PRISM
00301 !         IL1=1 IF POINT AT THE TOP OF ORIGINAL PRISM ,ETC. FOR IL2...
00302       IL1=IL1-ILOW
00303       IL2=IL2-ILOW
00304       IL3=IL3-ILOW
00305       IL4=IL4-ILOW
00306 !     DZ1, DZ2, DZ3, DZ4 WILL BE THE DELTA(Z) ABOVE OR BELOW EVERY POINT IN
00307 !     THE ORIGINAL PRISM
00308       IF(IL1.EQ.0) THEN
00309         DZ1=Z(I1+NPOIN2)-Z(I1)
00310       ELSE
00311         DZ1=Z(I1)-Z(I1-NPOIN2)
00312       ENDIF
00313       IF(IL2.EQ.0) THEN
00314         DZ2=Z(I2+NPOIN2)-Z(I2)
00315       ELSE
00316         DZ2=Z(I2)-Z(I2-NPOIN2)
00317       ENDIF
00318       IF(IL3.EQ.0) THEN
00319         DZ3=Z(I3+NPOIN2)-Z(I3)
00320       ELSE
00321         DZ3=Z(I3)-Z(I3-NPOIN2)
00322       ENDIF
00323       IF(IL4.EQ.0) THEN
00324         DZ4=Z(I4+NPOIN2)-Z(I4)
00325       ELSE
00326         DZ4=Z(I4)-Z(I4-NPOIN2)
00327       ENDIF
00328 !
00329 !     SEE MT02PP FOR A SIMILAR LIMITATION
00330 !     DIFFUSION CONNECTIONS CUT IF ONE POINT IS CRUSHED IN THE ELEMENT
00331 !     THIS IS NECESSARY TO AVOID A MASS ERROR
00332 !
00333       IF(DZ1.LT.EPSI.OR.DZ2.LT.EPSI.OR.
00334      &   DZ3.LT.EPSI.OR.DZ4.LT.EPSI ) THEN
00335         HTOT=0.D0
00336         VTOT=0.D0
00337         WTOT=0.D0
00338       ELSE
00339         HTOT=F(I1)+F(I2)+F(I3)+F(I4)
00340         VTOT=G(I1)+G(I2)+G(I3)+G(I4)
00341         WTOT=H(I1)+H(I2)+H(I3)+H(I4)
00342       ENDIF
00343 !
00344       X2=X(I2)-X(I1)
00345       Y2=Y(I2)-Y(I1)
00346       Z2=Z(I2)-Z(I1)
00347       X3=X(I3)-X(I1)
00348       Y3=Y(I3)-Y(I1)
00349       Z3=Z(I3)-Z(I1)
00350       X4=X(I4)-X(I1)
00351       Y4=Y(I4)-Y(I1)
00352       Z4=Z(I4)-Z(I1)
00353 !
00354 !-----------------------------------------------------------------------
00355 !
00356       VOL6 = X2*(Y3*Z4-Y4*Z3)+Y2*(X4*Z3-X3*Z4)+Z2*(X3*Y4-X4*Y3)
00357 !
00358       T15 = -Y2*Z3+Y3*Z2
00359       T17 =  X2*Z4-X4*Z2
00360       T19 = -Y3*Z4+Y4*Z3
00361       T21 =  X2*Z3-X3*Z2
00362       T23 = -Y2*Z4+Y4*Z2
00363       T35 =  X3*Z4-X4*Z3
00364       T49 =  X3*Y4-X4*Y3
00365 !
00366 !     BEWARE, PROBLEM WITH TIDAL FLATS HERE
00367 !
00368       COEF=XMUL*SUR24/MAX(VOL6,1.D-10)
00369 !
00370       T28 = -T19+T23-T15
00371       T42 = -T35+T17-T21
00372       T51 = X2*Y4-X4*Y2
00373       T54 = T49-X2*Y4+X4*Y2+X2*Y3-X3*Y2
00374 !
00375       T(IELEM,1) =COEF*( HTOT*T28**2+VTOT*T42**2+WTOT*T54**2)
00376       T(IELEM,2) =COEF*( HTOT*T19**2+VTOT*T35**2+WTOT*T49**2)
00377       T(IELEM,3) =COEF*( HTOT*T23**2+VTOT*T17**2+WTOT*T51**2)
00378       XM(IELEM,1)=COEF*( HTOT*T28*T19+VTOT*T42*T35-WTOT*T54*T49)
00379       XM(IELEM,2)=COEF*(-HTOT*T28*T23-VTOT*T42*T17+WTOT*T54*T51)
00380       XM(IELEM,3)=-(XM(IELEM,2)+XM(IELEM,1)+T(IELEM,1))
00381       XM(IELEM,4)=COEF*(-HTOT*T19*T23-VTOT*T35*T17-WTOT*T49*T51)
00382       XM(IELEM,5)= -(XM(IELEM,4)+T(IELEM,2)+XM(IELEM,1))
00383       XM(IELEM,6)= -(T(IELEM,3)+XM(IELEM,4)+XM(IELEM,2))
00384       T(IELEM,4) = -(XM(IELEM,3)+XM(IELEM,5)+XM(IELEM,6))
00385 !
00386 !-----------------------------------------------------------------------
00387 !
00388       ENDDO
00389 !
00390       ELSEIF(SF%ELM.EQ.30.AND.SG%ELM.EQ.30.AND.SH%ELM.EQ.30.AND.
00391      &       ISO.EQ.1) THEN
00392 !
00393 !
00394 !-----------------------------------------------------------------------
00395 !
00396 !   P0 DISCRETISATION OF DIFFUSION COEFFICIENTS (CONSTANT ON AN ELEMENT)
00397 !
00398 !   LOOP ON THE PRISMS
00399 !
00400       DO IELEM=1,NELEM
00401 !
00402       I1=IKLE(IELEM,1)
00403       I2=IKLE(IELEM,2)
00404       I3=IKLE(IELEM,3)
00405       I4=IKLE(IELEM,4)
00406 !
00407 !     ONLY DIFFERENCE WITH LOOP 20
00408       HTOT=4*F(IELEM)
00409       VTOT=4*G(IELEM)
00410       WTOT=4*H(IELEM)
00411 !     END OF ONLY DIFFERENCE WITH LOOP 20
00412 !
00413 !-----------------------------------------------------------------------
00414 !
00415       X2=X(I2)-X(I1)
00416       Y2=Y(I2)-Y(I1)
00417       Z2=Z(I2)-Z(I1)
00418       X3=X(I3)-X(I1)
00419       Y3=Y(I3)-Y(I1)
00420       Z3=Z(I3)-Z(I1)
00421       X4=X(I4)-X(I1)
00422       Y4=Y(I4)-Y(I1)
00423       Z4=Z(I4)-Z(I1)
00424 !
00425 !-----------------------------------------------------------------------
00426 !    COEF:  THANKS MAPLE...
00427 !-----------------------------------------------------------------------
00428 !
00429       T1  = X2*Y3
00430       T3  = X2*Y4
00431       T5  = X3*Y2
00432       T7  = X4*Y2
00433       T9  = X3*Z2
00434       T11 = X4*Z2
00435 !     T13 = 4 TIMES THE TETRAHEDRON VOLUME ?
00436       T13 = T1*Z4-T3*Z3-T5*Z4+T7*Z3+T9*Y4-T11*Y3
00437 !
00438       T15 = -Y2*Z3+Y3*Z2
00439       T17 =  X2*Z4-T11
00440       T19 = -Y3*Z4+Y4*Z3
00441       T21 =  X2*Z3-T9
00442       T23 = -Y2*Z4+Y4*Z2
00443       T35 =  X3*Z4-X4*Z3
00444       T49 =  X3*Y4-X4*Y3
00445 !
00446 !     IF WIDTH MORE THAN 0.01 M
00447 !
00448 !     BEWARE, PROBLEM WITH TIDAL FLAT HERE
00449 !
00450 !      COEF=XMUL*SUR24/MAX(T13,0.01D0*SURF)
00451 !      COEF=XMUL*SUR24/MAX(T13,1.D-3)
00452       COEF=XMUL*SUR24/MAX(T13,1.D-10)
00453 !     COEF=XMUL*SUR24/T13
00454 !
00455       T28 = -T19+T23-T15
00456       T42 = -T35+T17-T21
00457       T51 = T3-T7
00458       T54 = T49-T3+T7+T1-T5
00459 !
00460       T(IELEM,1) =COEF*(HTOT*T28**2+VTOT*T42**2+WTOT*T54**2)
00461       T(IELEM,2) =COEF*(HTOT*T19**2+VTOT*T35**2+WTOT*T49**2)
00462       T(IELEM,3) =COEF*(HTOT*T23**2+VTOT*T17**2+WTOT*T51**2)
00463       XM(IELEM,1)=COEF*(HTOT*T28*T19+VTOT*T42*T35-WTOT*T54*T49)
00464       XM(IELEM,2)=COEF*(-HTOT*T28*T23-VTOT*T42*T17+WTOT*T54*T51)
00465       XM(IELEM,3)=-(XM(IELEM,2)+XM(IELEM,1)+T(IELEM,1))
00466       XM(IELEM,4)=COEF*(-HTOT*T19*T23-VTOT*T35*T17-WTOT*T49*T51)
00467       XM(IELEM,5)= -(XM(IELEM,4)+T(IELEM,2)+XM(IELEM,1))
00468       XM(IELEM,6)= -(T(IELEM,3)+XM(IELEM,4)+XM(IELEM,2))
00469       T(IELEM,4) = -(XM(IELEM,3)+XM(IELEM,5)+XM(IELEM,6))
00470 !
00471 !---------------------------------------------------------------
00472 !
00473       ENDDO ! IELEM
00474 !
00475       ELSEIF(SF%ELM.EQ.30.AND.ISO.EQ.6) THEN
00476 !
00477 !   P0 DISCRETISATION OF DIFFUSION COEFFICIENTS (CONSTANT ON AN ELEMENT)
00478 !   NONISOTROPIC VISCOSITY ==> 6 COMPONENTS
00479 !   THE FUNCTION DIFFUSION COEFFICIENT IS HERE A P0 NON DIAGONAL
00480 !   SYMMETRICAL TENSOR
00481 !
00482 !                / DXX DXY DXZ \   / F FG FH \
00483 !            D = | DYX DYY DYZ | = | X  G GH |
00484 !                \ DZX DZY DZZ /   \ X XX  H /
00485 !-----------------------------------------------------------------------
00486 !
00487 !   LOOP ON THE TETRAHEDRONS
00488 !
00489       DO IELEM=1,NELEM
00490 !
00491       I1=IKLE(IELEM,1)
00492       I2=IKLE(IELEM,2)
00493       I3=IKLE(IELEM,3)
00494       I4=IKLE(IELEM,4)
00495 !
00496       FTOT = 4.D0*F(IELEM          )
00497       GTOT = 4.D0*F(IELEM +   NELEM)
00498       HTOT = 4.D0*F(IELEM + 2*NELEM)
00499       GHTOT= 4.D0*F(IELEM + 3*NELEM)
00500       FHTOT= 4.D0*F(IELEM + 4*NELEM)
00501       FGTOT= 4.D0*F(IELEM + 5*NELEM)
00502 !
00503 !-----------------------------------------------------------------------
00504 !
00505       X2=X(I2)-X(I1)
00506       Y2=Y(I2)-Y(I1)
00507       Z2=Z(I2)-Z(I1)
00508       X3=X(I3)-X(I1)
00509       Y3=Y(I3)-Y(I1)
00510       Z3=Z(I3)-Z(I1)
00511       X4=X(I4)-X(I1)
00512       Y4=Y(I4)-Y(I1)
00513       Z4=Z(I4)-Z(I1)
00514 !
00515 !-----------------------------------------------------------------------
00516 !    COEF:  THANKS MAPLE...
00517 !-----------------------------------------------------------------------
00518 !
00519       T13 = X2*Y3*Z4-X2*Y4*Z3-Y2*X3*Z4+Y2*X4*Z3+Z2*X3*Y4-Z2*X4*Y3
00520 !
00521       AUX   = Y3*Z4-Y4*Z3-Y2*Z4+Z2*Y4+Y2*Z3-Z2*Y3
00522       AUXX  = X3*Z4-X4*Z3-X2*Z4+Z2*X4+X2*Z3-Z2*X3
00523       AUXXX = X3*Y4-X4*Y3-X2*Y4+Y2*X4+X2*Y3-Y2*X3
00524       AUX1 = FTOT*(Y3*Z4-Y4*Z3-Y2*Z4+Z2*Y4+Y2*Z3-Z2*Y3)
00525       AUX2 = FGTOT*(-X3*Z4+X4*Z3+X2*Z4-Z2*X4-X2*Z3+Z2*X3)
00526       AUX3 = FHTOT*(X3*Y4-X4*Y3-X2*Y4+Y2*X4+X2*Y3-Y2*X3)
00527       AUX4 = GTOT*(-X3*Z4+X4*Z3+X2*Z4-Z2*X4-X2*Z3+Z2*X3)
00528       AUX5 = GHTOT*(X3*Y4-X4*Y3-X2*Y4+Y2*X4+X2*Y3-Y2*X3)
00529       AUX6 = FGTOT*(Y3*Z4-Y4*Z3-Y2*Z4+Z2*Y4+Y2*Z3-Z2*Y3)
00530       AUX7 = HTOT*(X3*Y4-X4*Y3-X2*Y4+Y2*X4+X2*Y3-Y2*X3)
00531       AUX8 = FHTOT*(Y3*Z4-Y4*Z3-Y2*Z4+Z2*Y4+Y2*Z3-Z2*Y3)
00532       AUX9 = GHTOT*(-X3*Z4+X4*Z3+X2*Z4-Z2*X4-X2*Z3+Z2*X3)
00533 !
00534       COEF=XMUL*SUR24/MAX(T13,1.D-14)
00535 !
00536       T(IELEM,1) =COEF*(AUX*(AUX1+AUX2+AUX3)
00537      & -AUXX*(AUX4+AUX5+AUX6)+AUXXX*(AUX7+AUX8+AUX9))
00538       T(IELEM,2) =COEF*((Y3*Z4-Y4*Z3)*
00539      & (FTOT*(Y3*Z4-Y4*Z3)+FGTOT*(-X3*Z4+X4*Z3)+FHTOT*(X3*Y4-X4*Y3))
00540      & -(X3*Z4-X4*Z3)*(GTOT*(-X3*Z4+X4*Z3)+FGTOT*(Y3*Z4-Y4*Z3)
00541      & +GHTOT*(X3*Y4-X4*Y3))+(X3*Y4-X4*Y3)*(HTOT*(X3*Y4-X4*Y3)
00542      & +FHTOT*(Y3*Z4-Y4*Z3)+GHTOT*(-X3*Z4+X4*Z3)))
00543       T(IELEM,3) =COEF*((Y2*Z4-Z2*Y4)*(FTOT*(Y2*Z4-Z2*Y4)+
00544      & FGTOT*(-X2*Z4+Z2*X4)+FHTOT*(X2*Y4-Y2*X4))-
00545      & (X2*Z4-Z2*X4)*(GTOT*(-X2*Z4+Z2*X4)+FGTOT*(Y2*Z4-Z2*Y4)+
00546      & GHTOT*(X2*Y4-Y2*X4))+(X2*Y4-Y2*X4)*(HTOT*(X2*Y4-Y2*X4)+
00547      & FHTOT*(Y2*Z4-Z2*Y4)+GHTOT*(-X2*Z4+Z2*X4)))
00548       T(IELEM,4) =COEF*((Y2*Z3-Z2*Y3)*(FTOT*(Y2*Z3-Z2*Y3)+
00549      & FGTOT*(-X2*Z3+Z2*X3)+FHTOT*(X2*Y3-Y2*X3))-
00550      & (X2*Z3-Z2*X3)*(GTOT*(-X2*Z3+Z2*X3)+FGTOT*(Y2*Z3-Z2*Y3)+
00551      & GHTOT*(X2*Y3-Y2*X3))+(X2*Y3-Y2*X3)*(HTOT*(X2*Y3-Y2*X3)+
00552      & FHTOT*(Y2*Z3-Z2*Y3)+GHTOT*(-X2*Z3+Z2*X3)))
00553       XM(IELEM,1)=COEF*((X3*Z4-X4*Z3)*(AUX4+AUX5+AUX6)-
00554      & (Y3*Z4-Y4*Z3)*(AUX1+AUX2+AUX3)-(X3*Y4-X4*Y3)*(AUX7+AUX8+AUX9))
00555       XM(IELEM,2)=COEF*((Y2*Z4-Z2*Y4)*(AUX1+AUX2+AUX3)-
00556      & (X2*Z4-Z2*X4)*(AUX4+AUX5+AUX6)+(X2*Y4-Y2*X4)*(AUX7+AUX8+AUX9))
00557       XM(IELEM,3)=COEF*((X2*Z3-Z2*X3)*(AUX4+AUX5+AUX6)-
00558      & (Y2*Z3-Z2*Y3)*(AUX1+AUX2+AUX3)-(X2*Y3-Y2*X3)*(AUX7+AUX8+AUX9))
00559       XM(IELEM,4)=COEF*((X2*Z4-Z2*X4)*(GTOT*(-X3*Z4+X4*Z3)+
00560      & FGTOT*(Y3*Z4-Y4*Z3)+GHTOT*(X3*Y4-X4*Y3))-
00561      & (Y2*Z4-Z2*Y4)*(FTOT*(Y3*Z4-Y4*Z3)+FGTOT*(-X3*Z4+X4*Z3)+
00562      & FHTOT*(X3*Y4-X4*Y3))-(X2*Y4-Y2*X4)*(HTOT*(X3*Y4-X4*Y3)+
00563      & FHTOT*(Y3*Z4-Y4*Z3)+GHTOT*(-X3*Z4+X4*Z3)))
00564       XM(IELEM,5)=COEF*((Y2*Z3-Z2*Y3)*(FTOT*(Y3*Z4-Y4*Z3)+
00565      & FGTOT*(-X3*Z4+X4*Z3)+FHTOT*(X3*Y4-X4*Y3))-
00566      & (X2*Z3-Z2*X3)*(GTOT*(-X3*Z4+X4*Z3)+FGTOT*(Y3*Z4-Y4*Z3)
00567      & +GHTOT*(X3*Y4-X4*Y3))+(X2*Y3-Y2*X3)*(HTOT*(X3*Y4-X4*Y3)
00568      & +FHTOT*(Y3*Z4-Y4*Z3)+GHTOT*(-X3*Z4+X4*Z3)))
00569       XM(IELEM,6)=COEF*((X2*Z3-Z2*X3)*(GTOT*(-X2*Z4+Z2*X4)+
00570      & FGTOT*(Y2*Z4-Z2*Y4)+GHTOT*(X2*Y4-Y2*X4))-
00571      & (Y2*Z3-Z2*Y3)*(FTOT*(Y2*Z4-Z2*Y4)+FGTOT*(-X2*Z4+Z2*X4)+
00572      & FHTOT*(X2*Y4-Y2*X4))-(X2*Y3-Y2*X3)*(HTOT*(X2*Y4-Y2*X4)+
00573      & FHTOT*(Y2*Z4-Z2*Y4)+GHTOT*(-X2*Z4+Z2*X4)))
00574       ENDDO ! IELEM
00575 !
00576       ELSE
00577 !
00578         IF (LNG.EQ.1) WRITE(LU,1000) SF%ELM,SG%ELM,SH%ELM
00579         IF (LNG.EQ.2) WRITE(LU,1001) SF%ELM,SG%ELM,SH%ELM
00580 1000    FORMAT(1X,'MT02TT (BIEF) : MAUVAIS TYPE DE F,G OU H : ',
00581      &  I6,1X,I6,1X,I6)
00582 1001    FORMAT(1X,'MT02TT (BIEF) : WRONG TYPE OF F,G OR H: ',
00583      &  I6,1X,I6,1X,I6)
00584         CALL PLANTE(1)
00585         STOP
00586 !
00587       ENDIF
00588 !
00589 !-----------------------------------------------------------------------
00590 !
00591 !  TREATMENT OF HYDROSTATIC INCONSISTENCIES
00592 !
00593 !     IF(INCHYD) THEN
00594 !
00595 !     DO IELEM=1,NELEM
00596 !
00597 !        I1=IKLE(IELEM,1)
00598 !        I2=IKLE(IELEM,2)
00599 !        I3=IKLE(IELEM,3)
00600 !        I4=IKLE(IELEM,4)
00601 !
00602 !        IF(MAX(Z(I1),Z(I2),Z(I3)).GT.MIN(Z(I4),Z(I5),Z(I6))) THEN
00603 !
00604 !          T(IELEM,1)  =0.D0
00605 !          T(IELEM,2)  =0.D0
00606 !          T(IELEM,3)  =0.D0
00607 !          T(IELEM,4)  =0.D0
00608 !          XM(IELEM, 1)=0.D0
00609 !          XM(IELEM, 2)=0.D0
00610 !          XM(IELEM, 3)=0.D0
00611 !          XM(IELEM, 4)=0.D0
00612 !          XM(IELEM, 5)=0.D0
00613 !          XM(IELEM, 6)=0.D0
00614 !
00615 !        ENDIF
00616 !
00617 !      ENDDO ! IELEM
00618 !
00619 !     ENDIF
00620 !
00621 !-----------------------------------------------------------------------
00622 !
00623       RETURN
00624       END

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