mt06ft2.f

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

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