mt06oc.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mt06oc.f
00002 !
00067                      SUBROUTINE MT06OC
00068 !                    *****************
00069 !
00070      &(A11,A12,A13,A22,A23,A33,
00071      & XMUL,SF,F,LGSEG,IKLE1,IKLE2,IKLE3,NBOR,NELEM,NELMAX)
00072 !
00073 !***********************************************************************
00074 ! BIEF   V6P1                                   21/08/2010
00075 !***********************************************************************
00076 !
00077 !
00078 !
00079 !
00080 !
00081 !
00082 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00083 !| A11            |<--| ELEMENTS OF MATRIX
00084 !| A12            |<--| ELEMENTS OF MATRIX
00085 !| A13            |<--| ELEMENTS OF MATRIX
00086 !| A22            |<--| ELEMENTS OF MATRIX
00087 !| A23            |<--| ELEMENTS OF MATRIX
00088 !| A33            |<--| ELEMENTS OF MATRIX
00089 !| F              |-->| FUNCTION F USED IN THE FORMULA
00090 !| IKLE1          |-->| FIRST POINTS OF SEGMENTS
00091 !| IKLE2          |-->| SECOND POINTS OF SEGMENTS
00092 !| IKLE3          |-->| THIRD POINTS OF SEGMENTS (QUADRATIC)
00093 !| LGSEG          |-->| LENGTH OF SEGMENTS
00094 !| NBOR           |-->| GLOBAL NUMBER OF BOUNDARY POINTS
00095 !| NELEM          |-->| NUMBER OF ELEMENTS
00096 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00097 !| SF             |-->| BIEF_OBJ STRUCTURE OF F
00098 !| SURFAC         |-->| AREA OF TRIANGLES
00099 !| XMUL           |-->| MULTIPLICATION FACTOR
00100 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00101 !
00102       USE BIEF!, EX_MT06OC => MT06OC
00103 !
00104       IMPLICIT NONE
00105       INTEGER LNG,LU
00106       COMMON/INFO/LNG,LU
00107 !
00108 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00109 !
00110       INTEGER, INTENT(IN) :: NELEM,NELMAX,NBOR(NELMAX,3)
00111       INTEGER, INTENT(IN) :: IKLE1(*),IKLE2(*),IKLE3(*)
00112 !
00113       DOUBLE PRECISION, INTENT(IN) :: XMUL
00114 !
00115       DOUBLE PRECISION, INTENT(IN) :: F(*)
00116 !
00117 !     STRUCTURE OF F
00118       TYPE(BIEF_OBJ), INTENT(IN) :: SF
00119 !
00120       DOUBLE PRECISION, INTENT(IN)    :: LGSEG(NELMAX)
00121       DOUBLE PRECISION, INTENT(INOUT) :: A11(NELMAX),A12(NELMAX)
00122       DOUBLE PRECISION, INTENT(INOUT) :: A13(NELMAX),A22(NELMAX)
00123       DOUBLE PRECISION, INTENT(INOUT) :: A23(NELMAX),A33(NELMAX)
00124 !
00125 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00126 !
00127       INTEGER IELEM,IELMF
00128       DOUBLE PRECISION SUR30,SUR60,SUR420,DET1,F1,F2,F3
00129 !
00130 !-----------------------------------------------------------------------
00131 !
00132       SUR30  = XMUL/30.D0
00133       SUR60  = XMUL/60.D0
00134       SUR420  = XMUL/420.D0
00135 !
00136 !-----------------------------------------------------------------------
00137 !
00138       IELMF = SF%ELM
00139 !
00140 !     F CONSTANT BY SEGMENT, IN A BOUNDARY ARRAY
00141 !
00142       IF(IELMF.EQ.0) THEN
00143 !
00144       DO IELEM = 1 , NELEM
00145       F1 = F(IELEM)
00146       DET1 = LGSEG(IELEM) * SUR30
00147 !
00148       A11(IELEM) = DET1 * (4.D0*F1)
00149       A12(IELEM) = DET1 * (-F1)
00150       A13(IELEM) = DET1 * (2.D0*F1)
00151       A22(IELEM) = A11(IELEM)
00152       A23(IELEM) = A13(IELEM)
00153       A33(IELEM) = DET1 * (16.D0*F1)
00154 !
00155       ENDDO ! IELEM
00156 !
00157 !     F LINEAR BY SEGMENT, IN A BOUNDARY ARRAY
00158 !     NOTE: IKLE IS HERE A BOUNDARY IKLE
00159 !
00160       ELSEIF(IELMF.EQ.1) THEN
00161 !
00162       DO IELEM = 1 , NELEM
00163 !
00164       F1 = F(IKLE1(IELEM))
00165       F2 = F(IKLE2(IELEM))
00166 !
00167       DET1 = LGSEG(IELEM) * SUR60
00168 !
00169       A11(IELEM) = DET1 * (7.D0*F1+F2)
00170       A12(IELEM) = DET1 * (-F1-F2)
00171       A13(IELEM) = DET1 * (4.D0*F1)
00172       A22(IELEM) = DET1 * (F1+7.D0*F2)
00173       A23(IELEM) = DET1 * (4.D0*F2)
00174       A33(IELEM) = DET1 * 16.D0 * (F1+F2)
00175 !
00176       ENDDO ! IELEM
00177 !
00178 !     F LINEAR, IN AN ARRAY DEFINED ON THE DOMAIN
00179 !
00180       ELSEIF(IELMF.EQ.11.OR.IELMF.EQ.21) THEN
00181 !
00182       DO IELEM = 1 , NELEM
00183 !
00184       F1 = F(NBOR(IELEM,1))
00185       F2 = F(NBOR(IELEM,2))
00186 !
00187       DET1 = LGSEG(IELEM) * SUR60
00188 !
00189       A11(IELEM) = DET1 * (7.D0*F1+F2)
00190       A12(IELEM) = DET1 * (-F1-F2)
00191       A13(IELEM) = DET1 * (4.D0*F1)
00192       A22(IELEM) = DET1 * (F1+7.D0*F2)
00193       A23(IELEM) = DET1 * (4.D0*F2)
00194       A33(IELEM) = DET1 * 16.D0 * (F1+F2)
00195 !
00196       ENDDO ! IELEM
00197 !
00198 !     F QUADRATIC BY SEGMENT, IN A BOUNDARY ARRAY
00199 !     NOTE: IKLE IS HERE A BOUNDARY IKLE
00200 !
00201       ELSEIF(IELMF.EQ.2) THEN
00202 !
00203       DO IELEM = 1 , NELEM
00204 !
00205       F1 = F(IKLE1(IELEM))
00206       F2 = F(IKLE2(IELEM))
00207       F3 = F(IKLE3(IELEM))
00208       DET1 = LGSEG(IELEM) * SUR420
00209 !
00210       A11(IELEM) = DET1 * (39.D0*F1-3.D0*F2+20.D0*F3)
00211       A12(IELEM) = DET1 * (-3.D0*F1-3.D0*F2-8.D0*F3)
00212       A13(IELEM) = DET1 * (20.D0*F1-8.D0*F2+16.D0*F3)
00213       A22(IELEM) = DET1 * (-3.D0*F1+39.D0*F2+20.D0*F3)
00214       A23(IELEM) = DET1 * (-8.D0*F1+20.D0*F2+16.D0*F3)
00215       A33(IELEM) = DET1 * 16.D0 * (F1+F2+12.D0*F3)
00216 !
00217       ENDDO ! IELEM
00218 !
00219 !     F QUADRATIC, IN AN ARRAY DEFINED ON THE DOMAIN
00220 !
00221       ELSEIF(IELMF.EQ.13) THEN
00222 !
00223       DO IELEM = 1 , NELEM
00224 !
00225       F1 = F(NBOR(IELEM,1))
00226       F2 = F(NBOR(IELEM,2))
00227       F3 = F(NBOR(IELEM,3))
00228 !
00229       DET1 = LGSEG(IELEM) * SUR420
00230 !
00231       A11(IELEM) = DET1 * (39.D0*F1-3.D0*F2+20.D0*F3)
00232       A12(IELEM) = DET1 * (-3.D0*F1-3.D0*F2-8.D0*F3)
00233       A13(IELEM) = DET1 * (20.D0*F1-8.D0*F2+16.D0*F3)
00234       A22(IELEM) = DET1 * (-3.D0*F1+39.D0*F2+20.D0*F3)
00235       A23(IELEM) = DET1 * (-8.D0*F1+20.D0*F2+16.D0*F3)
00236       A33(IELEM) = DET1 * 16.D0 * (F1+F2+12.D0*F3)
00237 !
00238       ENDDO ! IELEM
00239 !
00240 !     OTHER TYPES OF DISCRETISATION OF F
00241 !
00242       ELSE
00243 !
00244         IF (LNG.EQ.1) WRITE(LU,100) IELMF,SF%NAME
00245         IF (LNG.EQ.2) WRITE(LU,101) IELMF,SF%NAME
00246 100     FORMAT(1X,'MT06OC (BIEF) :',/,
00247      &         1X,'DISCRETISATION DE F NON PREVUE : ',1I6,
00248      &         1X,'NOM REEL : ',A6)
00249 101     FORMAT(1X,'MT06OC (BIEF) :',/,
00250      &         1X,'DISCRETIZATION OF F NOT AVAILABLE:',1I6,
00251      &         1X,'REAL NAME: ',A6)
00252         CALL PLANTE(1)
00253         STOP
00254 !
00255       ENDIF
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