vc13tt.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\vc13tt.f
00002 !
00086                      SUBROUTINE VC13TT
00087 !                    *****************
00088 !
00089      &(XMUL,SF,F,X,Y,Z,IKLE1,IKLE2,IKLE3,IKLE4,NELEM,NELMAX,
00090      & W1,W2,W3,W4,ICOORD,FORMUL)
00091 !
00092 !***********************************************************************
00093 ! BIEF   V6P2                                   21/08/2010
00094 !***********************************************************************
00095 !
00096 !
00097 !
00098 !
00099 !
00100 !
00101 !
00102 !
00103 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00104 !| F              |-->| FUNCTION USED IN THE VECTOR FORMULA
00105 !| FORMUL         |-->| SEE AT THE END OF THE SUBROUTINE
00106 !| ICOORD         |-->| 1: DERIVATIVE ALONG X, 2: ALONG Y
00107 !| IKLE1          |-->| FIRST POINT OF TETRAHEDRA
00108 !| IKLE2          |-->| SECOND POINT OF TETRAHEDRA
00109 !| IKLE3          |-->| THIRD POINT OF TETRAHEDRA
00110 !| IKLE4          |-->| FOURTH POINT OF TETRAHEDRA
00111 !| NELEM          |-->| NUMBER OF ELEMENTS
00112 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00113 !| SF             |-->| BIEF_OBJ STRUCTURE OF F
00114 !| SURFAC         |-->| AREA OF TRIANGLES
00115 !| W1             |<--| RESULT IN NON ASSEMBLED FORM
00116 !| W2             |<--| RESULT IN NON ASSEMBLED FORM
00117 !| W3             |<--| RESULT IN NON ASSEMBLED FORM
00118 !| W4             |<--| RESULT IN NON ASSEMBLED FORM
00119 !| XEL            |-->| ABSCISSAE OF POINTS IN THE MESH, PER ELEMENT
00120 !| XMUL           |-->| MULTIPLICATION COEFFICIENT
00121 !| YEL            |-->| ORDINATES OF POINTS IN THE MESH, PER ELEMENT
00122 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00123 !
00124       USE BIEF, EX_VC13TT => VC13TT
00125 !
00126       IMPLICIT NONE
00127       INTEGER LNG,LU
00128       COMMON/INFO/LNG,LU
00129 !
00130 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00131 !
00132       INTEGER, INTENT(IN) :: NELEM,NELMAX,ICOORD
00133       INTEGER, INTENT(IN) :: IKLE1(NELMAX),IKLE2(NELMAX)
00134       INTEGER, INTENT(IN) :: IKLE3(NELMAX),IKLE4(NELMAX)
00135 !
00136       DOUBLE PRECISION, INTENT(IN) :: X(*),Y(*),Z(*)
00137       DOUBLE PRECISION, INTENT(INOUT) :: W1(NELMAX),W2(NELMAX)
00138       DOUBLE PRECISION, INTENT(INOUT) :: W3(NELMAX),W4(NELMAX)
00139       DOUBLE PRECISION, INTENT(IN) :: XMUL
00140 !
00141 !     STRUCTURE OF F AND REAL DATA
00142 !
00143       TYPE(BIEF_OBJ), INTENT(IN) :: SF
00144       DOUBLE PRECISION, INTENT(IN) :: F(*)
00145       CHARACTER(LEN=16), INTENT(IN) :: FORMUL
00146 !
00147 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00148 !
00149       INTEGER IELEM,IELMF
00150       DOUBLE PRECISION X2,X3,X4,Y2,Y3,Y4,Z2,Z3,Z4,XSUR24,SUR6
00151       DOUBLE PRECISION VOL
00152       INTEGER I1,I2,I3,I4
00153 !
00154 !-----------------------------------------------------------------------
00155 !
00156       SUR6=1.D0/6.D0
00157       XSUR24 = XMUL/24.D0
00158 !
00159 !-----------------------------------------------------------------------
00160 !
00161       IELMF=SF%ELM
00162 !
00163 !=======================================================================
00164 !
00165 !     FILTERING OPTIONS NOT TREATED
00166 !
00167       IF(FORMUL(6:6).EQ.'2') THEN
00168         WRITE(LU,*) 'VC13TT: FORMUL=',FORMUL
00169         WRITE(LU,*) '        OPTION NOT TREATED'
00170         CALL PLANTE(1)
00171         STOP
00172       ENDIF
00173 !
00174 !-----------------------------------------------------------------------
00175 !
00176 !     F IS LINEAR
00177 !
00178       IF(IELMF.EQ.31.OR.IELMF.EQ.51) THEN
00179 !
00180       IF(ICOORD.EQ.1) THEN
00181 !
00182 !-----------------------------------------------------------------------
00183 !
00184 !     DERIVATIVE WITH RESPECT TO X
00185 !
00186       DO IELEM = 1 , NELEM
00187 !
00188         I1 = IKLE1(IELEM)
00189         I2 = IKLE2(IELEM)
00190         I3 = IKLE3(IELEM)
00191         I4 = IKLE4(IELEM)
00192 !
00193 !       REAL COORDINATES OF THE POINTS OF THE ELEMENT (ORIGIN IN 1)
00194 !
00195         Y2  =  Y(I2) - Y(I1)
00196         Y3  =  Y(I3) - Y(I1)
00197         Y4  =  Y(I4) - Y(I1)
00198         Z2  =  Z(I2) - Z(I1)
00199         Z3  =  Z(I3) - Z(I1)
00200         Z4  =  Z(I4) - Z(I1)
00201 !
00202         W1(IELEM)=(  (F(I2)-F(I1))*(Y3*Z4-Y4*Z3)
00203      &              +(F(I3)-F(I1))*(Z2*Y4-Y2*Z4)
00204      &              +(F(I4)-F(I1))*(Y2*Z3-Z2*Y3)  )*XSUR24
00205 !
00206         W2(IELEM)=W1(IELEM)
00207         W3(IELEM)=W1(IELEM)
00208         W4(IELEM)=W1(IELEM)
00209 !
00210       ENDDO ! IELEM
00211 !
00212       ELSEIF(ICOORD.EQ.2) THEN
00213 !
00214 !-----------------------------------------------------------------------
00215 !
00216 !     DERIVATIVE WITH RESPECT TO Y
00217 !
00218       DO IELEM = 1 , NELEM
00219 !
00220         I1 = IKLE1(IELEM)
00221         I2 = IKLE2(IELEM)
00222         I3 = IKLE3(IELEM)
00223         I4 = IKLE4(IELEM)
00224 !
00225 !       REAL COORDINATES OF THE POINTS OF THE ELEMENT (ORIGIN IN 1)
00226 !
00227         X2  =  X(I2) - X(I1)
00228         X3  =  X(I3) - X(I1)
00229         X4  =  X(I4) - X(I1)
00230         Z2  =  Z(I2) - Z(I1)
00231         Z3  =  Z(I3) - Z(I1)
00232         Z4  =  Z(I4) - Z(I1)
00233 !
00234         W1(IELEM)=(  (F(I2)-F(I1))*(X4*Z3-X3*Z4)
00235      &              +(F(I3)-F(I1))*(X2*Z4-Z2*X4)
00236      &              +(F(I4)-F(I1))*(Z2*X3-X2*Z3)  )*XSUR24
00237 !
00238         W2(IELEM)=W1(IELEM)
00239         W3(IELEM)=W1(IELEM)
00240         W4(IELEM)=W1(IELEM)
00241 !
00242       ENDDO
00243 !
00244       ELSEIF(ICOORD.EQ.3) THEN
00245 !
00246 !-----------------------------------------------------------------------
00247 !
00248 !     DERIVATIVE WITH RESPECT TO Z
00249 !
00250       DO IELEM = 1 , NELEM
00251 !
00252         I1 = IKLE1(IELEM)
00253         I2 = IKLE2(IELEM)
00254         I3 = IKLE3(IELEM)
00255         I4 = IKLE4(IELEM)
00256 !
00257 !       REAL COORDINATES OF THE POINTS OF THE ELEMENT (ORIGIN IN 1)
00258 !
00259         X2  =  X(I2) - X(I1)
00260         X3  =  X(I3) - X(I1)
00261         X4  =  X(I4) - X(I1)
00262         Y2  =  Y(I2) - Y(I1)
00263         Y3  =  Y(I3) - Y(I1)
00264         Y4  =  Y(I4) - Y(I1)
00265 !
00266         W1(IELEM)=(  (F(I2)-F(I1))*(X3*Y4-X4*Y3)
00267      &              +(F(I3)-F(I1))*(Y2*X4-X2*Y4)
00268      &              +(F(I4)-F(I1))*(X2*Y3-Y2*X3)  )*XSUR24
00269 !
00270         W2(IELEM)=W1(IELEM)
00271         W3(IELEM)=W1(IELEM)
00272         W4(IELEM)=W1(IELEM)
00273 !
00274       ENDDO ! IELEM
00275 !
00276       ELSE
00277 !
00278 !-----------------------------------------------------------------------
00279 !
00280         IF (LNG.EQ.1) WRITE(LU,200) ICOORD
00281         IF (LNG.EQ.2) WRITE(LU,201) ICOORD
00282 200     FORMAT(1X,'VC13TT (BIEF) : COMPOSANTE IMPOSSIBLE ',
00283      &            1I6,' VERIFIER ICOORD')
00284 201     FORMAT(1X,'VC13TT (BIEF) : IMPOSSIBLE COMPONENT ',
00285      &            1I6,' CHECK ICOORD')
00286         CALL PLANTE(1)
00287         STOP
00288 !
00289       ENDIF
00290 !
00291 !=======================================================================
00292 !
00293       ELSE
00294 !
00295 !=======================================================================
00296 !
00297         IF (LNG.EQ.1) WRITE(LU,101) IELMF,SF%NAME
00298         IF (LNG.EQ.2) WRITE(LU,102) IELMF,SF%NAME
00299 101     FORMAT(1X,'VC13TT (BIEF) :',/,
00300      &         1X,'DISCRETISATION DE F : ',1I6,' CAS NON PREVU',/,
00301      &         1X,'NOM REEL DE F : ',A6)
00302 102     FORMAT(1X,'VC13TT (BIEF) :',/,
00303      &         1X,'DISCRETISATION OF F : ',1I6,' NOT IMPLEMENTED',/,
00304      &         1X,'REAL NAME OF F: ',A6)
00305         CALL PLANTE(1)
00306         STOP
00307 !
00308       ENDIF
00309 !
00310 !=======================================================================
00311 !
00312 !     FILTER FOR PARTLY CRUSHED ELEMENTS (ON THE VERTICAL)
00313 !
00314       IF(FORMUL(7:7).EQ.'2') THEN
00315 !
00316         DO IELEM = 1 , NELEM
00317           I1 = IKLE1(IELEM)
00318           I2 = IKLE2(IELEM)
00319           I3 = IKLE3(IELEM)
00320           I4 = IKLE4(IELEM)
00321 !
00322           X2=X(I2)-X(I1)
00323           Y2=Y(I2)-Y(I1)
00324           Z2=Z(I2)-Z(I1)
00325           X3=X(I3)-X(I1)
00326           Y3=Y(I3)-Y(I1)
00327           Z3=Z(I3)-Z(I1)
00328           X4=X(I4)-X(I1)
00329           Y4=Y(I4)-Y(I1)
00330           Z4=Z(I4)-Z(I1)
00331 !
00332           VOL=(Z2*(X3*Y4-X4*Y3)+Y2*(X4*Z3-X3*Z4)+X2*(Y3*Z4-Y4*Z3))*SUR6
00333 !
00334 !         TEST DE VC13PP
00335 !         IF(Z(I4)-Z(I1).LT.1.D-3.OR.
00336 !    &       Z(I5)-Z(I2).LT.1.D-3.OR.
00337 !    &       Z(I6)-Z(I3).LT.1.D-3     ) THEN
00338 !
00339 !         HIDDEN PARAMETER !!!!!!!!!!!!!!!!!!!
00340 !
00341           IF(VOL.LT.1.D-6) THEN
00342             W1(IELEM)=0.D0
00343             W2(IELEM)=0.D0
00344             W3(IELEM)=0.D0
00345             W4(IELEM)=0.D0
00346           ENDIF
00347         ENDDO
00348 !
00349       ELSEIF(FORMUL(7:7).NE.' ') THEN
00350         WRITE(LU,*) 'VC13TT: FORMUL=',FORMUL
00351         WRITE(LU,*) '        OPTION NOT TREATED'
00352         CALL PLANTE(1)
00353         STOP
00354       ENDIF
00355 !
00356 !=======================================================================
00357 !
00358       RETURN
00359       END

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