mt06bb.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mt06bb.f
00002 !
00068                      SUBROUTINE MT06BB
00069 !                    *****************
00070 !
00071      &( A11 , A12 , A13 , A14 ,
00072      &        A22 , A23 , A24 ,
00073      &              A33 , A34 ,
00074      &                    A44 ,
00075      &  XMUL,SF,F,SURFAC,IKLE1,IKLE2,IKLE3,IKLE4,NELEM,NELMAX)
00076 !
00077 !***********************************************************************
00078 ! BIEF   V6P1                                   21/08/2010
00079 !***********************************************************************
00080 !
00081 !
00082 !
00083 !
00084 !
00085 !
00086 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00087 !| A11            |<--| ELEMENTS OF MATRIX
00088 !| A12            |<--| ELEMENTS OF MATRIX
00089 !| A13            |<--| ELEMENTS OF MATRIX
00090 !| A14            |<--| ELEMENTS OF MATRIX
00091 !| A22            |<--| ELEMENTS OF MATRIX
00092 !| A23            |<--| ELEMENTS OF MATRIX
00093 !| A24            |<--| ELEMENTS OF MATRIX
00094 !| A33            |<--| ELEMENTS OF MATRIX
00095 !| A34            |<--| ELEMENTS OF MATRIX
00096 !| A44            |<--| ELEMENTS OF MATRIX
00097 !| F              |-->| FUNCTION F USED IN THE FORMULA
00098 !| IKLE1          |-->| FIRST POINTS OF TRIANGLES
00099 !| IKLE2          |-->| SECOND POINTS OF TRIANGLES
00100 !| IKLE3          |-->| THIRD POINTS OF TRIANGLES
00101 !| IKLE4          |-->| QUASI-BUBBLE POINT
00102 !| NELEM          |-->| NUMBER OF ELEMENTS
00103 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00104 !| SF             |-->| BIEF_OBJ STRUCTURE OF F
00105 !| SURFAC         |-->| AREA OF TRIANGLES
00106 !| XMUL           |-->| MULTIPLICATION FACTOR
00107 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00108 !
00109       USE BIEF, EX_MT06BB => MT06BB
00110 !
00111       IMPLICIT NONE
00112       INTEGER LNG,LU
00113       COMMON/INFO/LNG,LU
00114 !
00115 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00116 !
00117       INTEGER, INTENT(IN) :: NELEM,NELMAX
00118       INTEGER, INTENT(IN) :: IKLE1(NELMAX),IKLE2(NELMAX)
00119       INTEGER, INTENT(IN) :: IKLE3(NELMAX),IKLE4(NELMAX)
00120 !
00121       DOUBLE PRECISION, INTENT(INOUT) :: A11(*),A12(*),A13(*),A14(*)
00122       DOUBLE PRECISION, INTENT(INOUT) ::        A22(*),A23(*),A24(*)
00123       DOUBLE PRECISION, INTENT(INOUT) ::               A33(*),A34(*)
00124       DOUBLE PRECISION, INTENT(INOUT) ::                      A44(*)
00125 !
00126       DOUBLE PRECISION, INTENT(IN) :: XMUL
00127       DOUBLE PRECISION, INTENT(IN) :: F(*)
00128 !
00129 !     STRUCTURE OF F
00130       TYPE(BIEF_OBJ), INTENT(IN) :: SF
00131 !
00132       DOUBLE PRECISION, INTENT(IN) :: SURFAC(NELMAX)
00133 !
00134 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00135 !
00136 !     DECLARATIONS SPECIFIC TO THIS SUBROUTINE
00137 !
00138       DOUBLE PRECISION F1,F2,F3,F4,XMS090,XMS180,XMS540
00139       DOUBLE PRECISION XMS018,XMS054,XMS006,XMS009,XMS036
00140       INTEGER IELMF,IELEM
00141 !
00142 !=======================================================================
00143 !
00144 !     EXTRACTS THE TYPE OF ELEMENT FOR F
00145 !
00146       IELMF = SF%ELM
00147 !
00148 !  CASE WHERE F IS P0
00149 !
00150       IF(IELMF.EQ.10) THEN
00151 !
00152       XMS009 = XMUL /  9.D0
00153       XMS006 = XMUL /  6.D0
00154       XMS018 = XMUL / 18.D0
00155       XMS036 = XMUL / 36.D0
00156 !
00157       DO IELEM = 1 , NELEM
00158 !
00159 !   INITIALISES THE GEOMETRICAL VARIABLES
00160 !
00161         F1  =  F(IELEM) * SURFAC(IELEM)
00162 !
00163 !  DIAGONAL TERMS
00164 !
00165         A11(IELEM) = F1*XMS009
00166         A22(IELEM) = F1*XMS009
00167         A33(IELEM) = F1*XMS009
00168         A44(IELEM) = F1*XMS006
00169 !
00170 !  EXTRADIAGONAL TERMS
00171 !
00172         A12(IELEM) = F1*XMS036
00173         A13(IELEM) = F1*XMS036
00174         A14(IELEM) = F1*XMS018
00175         A23(IELEM) = F1*XMS036
00176         A24(IELEM) = F1*XMS018
00177         A34(IELEM) = F1*XMS018
00178 !
00179       ENDDO ! IELEM
00180 !
00181 !
00182 !-----------------------------------------------------------------------
00183 !
00184 !  CASE WHERE F IS LINEAR
00185 !
00186       ELSEIF(IELMF.EQ.11) THEN
00187 !
00188       XMS054 = XMUL /  54.D0
00189       XMS018 = XMUL /  18.D0
00190       XMS540 = XMUL / 540.D0
00191 !
00192       DO IELEM = 1 , NELEM
00193 !
00194 !   INITIALISES THE GEOMETRICAL VARIABLES
00195 !
00196         F1  =  F(IKLE1(IELEM))
00197         F2  =  F(IKLE2(IELEM))
00198         F3  =  F(IKLE3(IELEM))
00199 !
00200 !   INITIALISES THE INTERMEDIATE VARIABLES
00201 !
00202 !
00203 !  DIAGONAL TERMS
00204 !
00205         A11(IELEM) = (SURFAC(IELEM)*(F3+F2+4*F1))*XMS054
00206         A22(IELEM) = (SURFAC(IELEM)*(F3+4*F2+F1))*XMS054
00207         A33(IELEM) = (SURFAC(IELEM)*(4*F3+F2+F1))*XMS054
00208         A44(IELEM) = (SURFAC(IELEM)*(F3+F2+F1))  *XMS018
00209 !
00210 !  EXTRADIAGONAL TERMS
00211 !
00212         A12(IELEM) = (SURFAC(IELEM)*(   F3+ 7*F2+ 7*F1))*XMS540
00213         A13(IELEM) = (SURFAC(IELEM)*( 7*F3+   F2+ 7*F1))*XMS540
00214         A14(IELEM) = (SURFAC(IELEM)*( 7*F3+ 7*F2+16*F1))*XMS540
00215         A23(IELEM) = (SURFAC(IELEM)*( 7*F3+ 7*F2+   F1))*XMS540
00216         A24(IELEM) = (SURFAC(IELEM)*( 7*F3+16*F2+ 7*F1))*XMS540
00217         A34(IELEM) = (SURFAC(IELEM)*(16*F3+ 7*F2+ 7*F1))*XMS540
00218 !
00219       ENDDO ! IELEM
00220 !
00221 !-----------------------------------------------------------------------
00222 !
00223       ELSEIF(IELMF.EQ.12) THEN
00224 !
00225 !-----------------------------------------------------------------------
00226 !
00227 !   QUASI-BUBBLE DISCRETISATION OF F:
00228 !
00229 !
00230       XMS090 = XMUL / 90.D0
00231       XMS180 = XMUL / 180.D0
00232 !
00233       DO IELEM = 1 , NELEM
00234 !
00235 !   INITIALISES THE GEOMETRICAL VARIABLES
00236 !
00237         F1  =  F(IKLE1(IELEM))
00238         F2  =  F(IKLE2(IELEM))
00239         F3  =  F(IKLE3(IELEM))
00240         F4  =  F(IKLE4(IELEM))
00241 !
00242 !  DIAGONAL TERMS
00243 !
00244         A11(IELEM) = (SURFAC(IELEM)*(  F3+2*F4+  F2+6*F1))*XMS090
00245         A22(IELEM) = (SURFAC(IELEM)*(  F3+2*F4+6*F2+  F1))*XMS090
00246         A33(IELEM) = (SURFAC(IELEM)*(6*F3+2*F4+  F2+  F1))*XMS090
00247         A44(IELEM) = (SURFAC(IELEM)*(2*F3+9*F4+2*F2+2*F1))*XMS090
00248 !
00249 !  EXTRADIAGONAL TERMS
00250 !
00251         A12(IELEM) = (SURFAC(IELEM)*(F4+2*F2+2*F1))*XMS180
00252         A13(IELEM) = (SURFAC(IELEM)*(2*F3+F4+2*F1))*XMS180
00253         A14(IELEM) = (SURFAC(IELEM)*(F3+4*F4+F2+4*F1))*XMS180
00254         A23(IELEM) = (SURFAC(IELEM)*(2*F3+F4+2*F2))*XMS180
00255         A24(IELEM) = (SURFAC(IELEM)*(F3+4*F4+4*F2+F1))*XMS180
00256         A34(IELEM) = (SURFAC(IELEM)*(4*F3+4*F4+F2+F1))*XMS180
00257 !
00258       ENDDO ! IELEM
00259 !
00260 !-----------------------------------------------------------------------
00261 !
00262 !   ANOTHER DISCRETISATION
00263 !      ELSEIF(IELMF.EQ.XX) THEN
00264 !
00265 !-----------------------------------------------------------------------
00266 !
00267       ELSE
00268 !
00269         IF (LNG.EQ.1) WRITE(LU,100) IELMF,SF%NAME
00270         IF (LNG.EQ.2) WRITE(LU,101) IELMF,SF%NAME
00271 100     FORMAT(1X,'MT06BB (BIEF) :',/,
00272      &         1X,'DISCRETISATION DE F NON PREVUE : ',1I6,
00273      &         1X,'NOM REEL : ',A6)
00274 101     FORMAT(1X,'MT06BB (BIEF) :',/,
00275      &         1X,'DISCRETIZATION OF F NOT AVAILABLE:',1I6,
00276      &         1X,'REAL NAME: ',A6)
00277         CALL PLANTE(1)
00278         STOP
00279 !
00280       ENDIF
00281 !
00282 !-----------------------------------------------------------------------
00283 !
00284       RETURN
00285       END

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