mt06ft.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mt06ft.f
00002 !
00072                      SUBROUTINE MT06FT
00073 !                    *****************
00074 !
00075      &( A11 , A12 , A13 ,
00076      &        A22 , A23 ,
00077      &              A33 ,
00078      &  XMUL,SF,F,X,Y,Z,IKLE1,IKLE2,IKLE3,NBOR,NELEM,NELMAX)
00079 !
00080 !***********************************************************************
00081 ! BIEF   V6P1                                   21/08/2010
00082 !***********************************************************************
00083 !
00084 !
00085 !
00086 !
00087 !
00088 !
00089 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00090 !| A11            |<--| ELEMENTS OF MATRIX
00091 !| A12            |<--| ELEMENTS OF MATRIX
00092 !| A13            |<--| ELEMENTS OF MATRIX
00093 !| A22            |<--| ELEMENTS OF MATRIX
00094 !| A23            |<--| ELEMENTS OF MATRIX
00095 !| A33            |<--| ELEMENTS OF MATRIX
00096 !| F              |-->| FUNCTION F USED IN THE FORMULA
00097 !| IKLE1          |-->| FIRST POINTS OF TRIANGLES
00098 !| IKLE2          |-->| SECOND POINTS OF TRIANGLES
00099 !| IKLE3          |-->| THIRD POINTS OF TRIANGLES
00100 !| NBOR           |-->| GLOBAL NUMBER OF BOUNDARY POINTS
00101 !| NELEM          |-->| NUMBER OF ELEMENTS
00102 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00103 !| SF             |-->| BIEF_OBJ STRUCTURE OF F
00104 !| SURFAC         |-->| AREA OF TRIANGLES
00105 !| XMUL           |-->| MULTIPLICATION FACTOR
00106 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00107 !
00108       USE BIEF, EX_MT06FT => MT06FT
00109 !
00110       IMPLICIT NONE
00111       INTEGER LNG,LU
00112       COMMON/INFO/LNG,LU
00113 !
00114 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00115 !
00116       INTEGER, INTENT(IN) :: NBOR(*),NELEM,NELMAX
00117       INTEGER, INTENT(IN) :: IKLE1(NELMAX),IKLE2(NELMAX),IKLE3(NELMAX)
00118 !
00119       DOUBLE PRECISION, INTENT(INOUT) :: A11(*),A12(*),A13(*)
00120       DOUBLE PRECISION, INTENT(INOUT) ::        A22(*),A23(*)
00121       DOUBLE PRECISION, INTENT(INOUT) ::               A33(*)
00122 !
00123       DOUBLE PRECISION, INTENT(IN) :: XMUL
00124       DOUBLE PRECISION, INTENT(IN) :: F(*)
00125 !
00126 !     STRUCTURE OF F
00127       TYPE(BIEF_OBJ), INTENT(IN) :: SF
00128 !
00129       DOUBLE PRECISION, INTENT(IN) :: X(*),Y(*),Z(*)
00130 !
00131 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00132 !
00133       INTRINSIC SQRT
00134 !
00135 !-----------------------------------------------------------------------
00136 !
00137 !     DECLARATIONS SPECIFIC TO THIS SUBROUTINE
00138 !
00139       INTEGER IELMF,I1,I2,I3,IELEM
00140 !
00141       DOUBLE PRECISION SUR60,S,X1,X2,X3,Y1,Y2,Y3,Z1,Z2,Z3,F1,F2,F3,F123
00142       DOUBLE PRECISION DET1,DET2
00143 !
00144 !**********************************************************************
00145 !
00146       IELMF=SF%ELM
00147 !
00148 !-----------------------------------------------------------------------
00149 !
00150 !     F LINEAR BY BOUNDARY SIDE
00151 !
00152       IF(IELMF.EQ.61.OR.IELMF.EQ.81) THEN
00153 !
00154         SUR60  = XMUL/60.D0
00155 !
00156 !   LOOP ON THE BOUNDARY SIDES
00157 !
00158         DO IELEM = 1,NELEM
00159 !
00160 !         GLOBAL NUMBERING OF THE SIDE VERTICES
00161 !
00162           I1 = NBOR(IKLE1(IELEM))
00163           I2 = NBOR(IKLE2(IELEM))
00164           I3 = NBOR(IKLE3(IELEM))
00165 !
00166           X1 = X(I1)
00167           Y1 = Y(I1)
00168           Z1 = Z(I1)
00169 !
00170           X2 = X(I2)-X1
00171           X3 = X(I3)-X1
00172           Y2 = Y(I2)-Y1
00173           Y3 = Y(I3)-Y1
00174           Z2 = Z(I2)-Z1
00175           Z3 = Z(I3)-Z1
00176 !
00177           F1 = F(IKLE1(IELEM))
00178           F2 = F(IKLE2(IELEM))
00179           F3 = F(IKLE3(IELEM))
00180           F123  = F1 + F2 + F3
00181 !
00182 !         COMPUTES THE AREA OF THE TRIANGLE (BY VECTOR PRODUCT)
00183 !
00184           S=0.5D0*SQRT(  (Y2*Z3-Y3*Z2)**2
00185      &                  +(X3*Z2-X2*Z3)**2
00186      &                  +(X2*Y3-X3*Y2)**2   )
00187 !
00188           DET1 = S * SUR60
00189           DET2 = DET1 + DET1
00190 !
00191 !***********************************************************************
00192 !
00193 !         ELEMENTS OFF THE DIAGONAL
00194 !
00195           A12(IELEM) = DET1 * (F123+F123-F3)
00196           A13(IELEM) = DET1 * (F123+F123-F2)
00197           A23(IELEM) = DET1 * (F123+F123-F1)
00198 !
00199 !         DIAGONAL TERMS
00200 !
00201           A11(IELEM) = DET2 * (F123+F1+F1)
00202           A22(IELEM) = DET2 * (F123+F2+F2)
00203           A33(IELEM) = DET2 * (F123+F3+F3)
00204 !
00205         ENDDO ! IELEM
00206 !
00207 !-----------------------------------------------------------------------
00208 !
00209 !     OTHER TYPES OF DISCRETISATION OF F
00210 !
00211       ELSE
00212 !
00213         IF (LNG.EQ.1) WRITE(LU,100) IELMF,SF%NAME
00214         IF (LNG.EQ.2) WRITE(LU,101) IELMF,SF%NAME
00215 100     FORMAT(1X,'MT06FT (BIEF) :',/,
00216      &         1X,'DISCRETISATION DE F NON PREVUE : ',1I6,
00217      &         1X,'NOM REEL : ',A6)
00218 101     FORMAT(1X,'MT06FT (BIEF) :',/,
00219      &         1X,'DISCRETIZATION OF F NOT AVAILABLE:',1I6,
00220      &         1X,'REAL NAME: ',A6)
00221         CALL PLANTE(1)
00222         STOP
00223 !
00224       ENDIF
00225 !
00226 !-----------------------------------------------------------------------
00227 !
00228 !     NOTE: ON A TRIANGULAR MESH IN PLANE (X, Y)
00229 !
00230 !     DO IELEM = 1 , NELEM
00231 !
00232 !     F1 = F(IKLE1(IELEM))
00233 !     F2 = F(IKLE2(IELEM))
00234 !     F3 = F(IKLE3(IELEM))
00235 !
00236 !     F123 = F1 + F2 + F3
00237 !
00238 !     DET1 = SURFAC(IELEM) * SUR60
00239 !     DET2 = DET1 + DET1
00240 !
00241 !***********************************************************************
00242 !
00243 !  ELEMENTS OFF THE DIAGONAL
00244 !
00245 !     A12(IELEM) = DET1 * (F123+F123-F3)
00246 !     A13(IELEM) = DET1 * (F123+F123-F2)
00247 !     A23(IELEM) = DET1 * (F123+F123-F1)
00248 !
00249 !  DIAGONAL TERMS
00250 !
00251 !     A11(IELEM) = DET2 * (F123+F1+F1)
00252 !     A22(IELEM) = DET2 * (F123+F2+F2)
00253 !     A33(IELEM) = DET2 * (F123+F3+F3)
00254 !
00255 !      ENDDO ! IELEM
00256 !
00257 !-----------------------------------------------------------------------
00258 !
00259       RETURN
00260       END

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