mt06ff.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mt06ff.f
00002 !
00075                      SUBROUTINE MT06FF
00076 !                    *****************
00077 !
00078      &( A11 , A12 , A13 , A14 ,
00079      &        A22 , A23 , A24 ,
00080      &              A33 , A34 ,
00081      &                    A44 ,
00082      &  XMUL,SF,F,X,Y,Z,IKLE1,IKLE2,IKLE3,IKLE4,NBOR,NELBOR,
00083      &  NULONE,NELEB,NELEBX,NELMAX)
00084 !
00085 !***********************************************************************
00086 ! BIEF   V6P3                                  21/08/2010
00087 !***********************************************************************
00088 !
00089 !
00090 !
00091 !
00092 !
00093 !
00094 !
00095 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00096 !| A11            |<--| ELEMENTS OF MATRIX
00097 !| A12            |<--| ELEMENTS OF MATRIX
00098 !| A13            |<--| ELEMENTS OF MATRIX
00099 !| A14            |<--| ELEMENTS OF MATRIX
00100 !| A22            |<--| ELEMENTS OF MATRIX
00101 !| A23            |<--| ELEMENTS OF MATRIX
00102 !| A24            |<--| ELEMENTS OF MATRIX
00103 !| A33            |<--| ELEMENTS OF MATRIX
00104 !| A34            |<--| ELEMENTS OF MATRIX
00105 !| A44            |<--| ELEMENTS OF MATRIX
00106 !| F              |-->| FUNCTION F USED IN THE FORMULA
00107 !| IKLE1          |-->| FIRST POINTS OF QUADRILATERALS
00108 !| IKLE2          |-->| SECOND POINTS OF QUADRILATERALS
00109 !| IKLE3          |-->| THIRD POINTS OF QUADRILATERALS
00110 !| IKLE4          |-->| FOURTH POINTS OF QUADRILATERALS
00111 !| NELBOR         |-->| ADJACENT ELEMENT NUMBER
00112 !| NELEM          |-->| NUMBER OF ELEMENTS
00113 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00114 !| NULONE         |-->| LOCAL NUMBERING OF BOUNDARY ELEMENT IN ADJACENT
00115 !|                |   | ELEMENT.
00116 !| SF             |-->| BIEF_OBJ STRUCTURE OF F
00117 !| SURFAC         |-->| AREA OF TRIANGLES
00118 !| XMUL           |-->| MULTIPLICATION FACTOR
00119 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00120 !
00121       USE BIEF, EX_MT06FF => MT06FF
00122 !
00123       IMPLICIT NONE
00124       INTEGER LNG,LU
00125       COMMON/INFO/LNG,LU
00126 !
00127 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00128 !
00129       INTEGER, INTENT(IN) :: NELEB,NELEBX,NELMAX
00130       INTEGER, INTENT(IN) :: NBOR(*),NELBOR(NELEBX),NULONE(NELEBX,4)
00131       INTEGER, INTENT(IN) :: IKLE1(NELEBX),IKLE2(NELEBX)
00132       INTEGER, INTENT(IN) :: IKLE3(NELEBX),IKLE4(NELEBX)
00133 !
00134       DOUBLE PRECISION, INTENT(INOUT) :: A11(*),A12(*),A13(*),A14(*)
00135       DOUBLE PRECISION, INTENT(INOUT) ::        A22(*),A23(*),A24(*)
00136       DOUBLE PRECISION, INTENT(INOUT) ::               A33(*),A34(*)
00137       DOUBLE PRECISION, INTENT(INOUT) ::                      A44(*)
00138 !
00139       DOUBLE PRECISION, INTENT(IN) :: XMUL
00140       DOUBLE PRECISION, INTENT(IN) :: F(*)
00141 !
00142 !     STRUCTURE OF F
00143       TYPE(BIEF_OBJ), INTENT(IN) :: SF
00144 !
00145       DOUBLE PRECISION, INTENT(IN) :: X(NELMAX,6),Y(NELMAX,6),Z(*)
00146 !
00147 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00148 !
00149       INTRINSIC SQRT
00150 !
00151 !     DECLARATIONS SPECIFIC TO THIS SUBROUTINE
00152 !
00153       INTEGER IELMF,I1,I2,I3,I4,IELEM,IEL,J1,J2
00154 !
00155       DOUBLE PRECISION SUR720,AL,S1,S2,S11112,S11122,S11222,S12222
00156       DOUBLE PRECISION F14,F23,F1114,F2223,F2333,F1444
00157 !
00158 !**********************************************************************
00159 !
00160       IELMF=SF%ELM
00161 !
00162 !-----------------------------------------------------------------------
00163 !
00164 !     F LINEAR BY BOUNDARY SIDE
00165 !
00166       IF(IELMF.EQ.71) THEN
00167 !
00168         SUR720  = XMUL/720.D0
00169 !
00170 !       LOOP ON THE BOUNDARY SIDES
00171 !
00172         DO IELEM = 1,NELEB
00173 !
00174           IEL=NELBOR(IELEM)
00175 !
00176           IF(IEL.GT.0) THEN
00177 !
00178 !           ELEMENT IN DOMAIN
00179 !
00180 !           GLOBAL NUMBERING OF THE SIDE VERTICES
00181 !
00182             I1 = IKLE1(IELEM)
00183             I2 = IKLE2(IELEM)
00184             I3 = IKLE3(IELEM)
00185             I4 = IKLE4(IELEM)
00186 !
00187             J1=NULONE(IELEM,1)
00188             J2=NULONE(IELEM,2)
00189             AL = SQRT((X(IEL,J2)-X(IEL,J1))**2
00190      &               +(Y(IEL,J2)-Y(IEL,J1))**2) * SUR720
00191 !
00192             S1 = (Z(NBOR(I4)) - Z(NBOR(I1))) * AL
00193             S2 = (Z(NBOR(I3)) - Z(NBOR(I2))) * AL
00194             S11112 = S1 + S1 + S1 + S1 + S2
00195             S11122 = S1 + S1 + S1 + S2 + S2
00196             S11222 = S1 + S1 + S2 + S2 + S2
00197             S12222 = S1 + S2 + S2 + S2 + S2
00198 !
00199             F14 = F(I1) + F(I4)
00200             F23 = F(I2) + F(I3)
00201             F1114 = F(I1) + F(I1) + F14
00202             F2223 = F(I2) + F(I2) + F23
00203             F2333 = F23 + F(I3) + F(I3)
00204             F1444 = F14 + F(I4) + F(I4)
00205 !
00206 !           DIAGONAL TERMS
00207 !
00208             A11(IELEM) = 3*F1114*S11112 + F2223*S11122
00209             A22(IELEM) = 3*F2223*S12222 + F1114*S11222
00210             A33(IELEM) = 3*F2333*S12222 + F1444*S11222
00211             A44(IELEM) = 3*F1444*S11112 + F2333*S11122
00212 !
00213 !           ELEMENTS OFF THE DIAGONAL
00214 !
00215             A12(IELEM) = F1114*S11122 + F2223*S11222
00216             A13(IELEM) =   F14*S11122 +   F23*S11222
00217             A14(IELEM) = 3*F14*S11112 +   F23*S11122
00218             A23(IELEM) = 3*F23*S12222 +   F14*S11222
00219             A24(IELEM) = A13(IELEM)
00220             A34(IELEM) = F2333*S11222 + F1444*S11122
00221 !
00222           ELSE
00223 !
00224 !           ELEMENT NOT IN DOMAIN (PARALLELISM)
00225 !
00226             A11(IELEM) = 0.D0
00227             A22(IELEM) = 0.D0
00228             A33(IELEM) = 0.D0
00229             A44(IELEM) = 0.D0
00230             A12(IELEM) = 0.D0
00231             A13(IELEM) = 0.D0
00232             A14(IELEM) = 0.D0
00233             A23(IELEM) = 0.D0
00234             A24(IELEM) = 0.D0
00235             A34(IELEM) = 0.D0
00236 !
00237           ENDIF
00238 !
00239         ENDDO ! IELEM
00240 !
00241 !-----------------------------------------------------------------------
00242 !
00243 !     OTHER TYPES OF DISCRETISATION OF F
00244 !
00245       ELSE
00246 !
00247         IF (LNG.EQ.1) WRITE(LU,100) IELMF,SF%NAME
00248         IF (LNG.EQ.2) WRITE(LU,101) IELMF,SF%NAME
00249 100     FORMAT(1X,'MT06FF (BIEF) :',/,
00250      &         1X,'DISCRETISATION DE F NON PREVUE : ',1I6,
00251      &         1X,'NOM REEL : ',A6)
00252 101     FORMAT(1X,'MT06FF (BIEF) :',/,
00253      &         1X,'DISCRETIZATION OF F NOT AVAILABLE:',1I6,
00254      &         1X,'REAL NAME: ',A6)
00255         CALL PLANTE(1)
00256         STOP
00257 !
00258       ENDIF
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