mt06aa.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mt06aa.f
00002 !
00070                      SUBROUTINE MT06AA
00071 !                    *****************
00072 !
00073      &( A11 , A12 , A13 ,
00074      &        A22 , A23 ,
00075      &              A33 ,
00076      &  XMUL,SF,F,SURFAC,IKLE1,IKLE2,IKLE3,NELEM,NELMAX)
00077 !
00078 !***********************************************************************
00079 ! BIEF   V6P1                                   21/08/2010
00080 !***********************************************************************
00081 !
00082 !
00083 !
00084 !
00085 !
00086 !
00087 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00088 !| A11            |<--| ELEMENTS OF MATRIX
00089 !| A12            |<--| ELEMENTS OF MATRIX
00090 !| A13            |<--| ELEMENTS OF MATRIX
00091 !| A22            |<--| ELEMENTS OF MATRIX
00092 !| A23            |<--| ELEMENTS OF MATRIX
00093 !| A33            |<--| ELEMENTS OF MATRIX
00094 !| F              |-->| FUNCTION F USED IN THE FORMULA
00095 !| IKLE1          |-->| FIRST POINTS OF TRIANGLES
00096 !| IKLE2          |-->| SECOND POINTS OF TRIANGLES
00097 !| IKLE3          |-->| THIRD POINTS OF TRIANGLES
00098 !| NELEM          |-->| NUMBER OF ELEMENTS
00099 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00100 !| SF             |-->| BIEF_OBJ STRUCTURE OF F
00101 !| SURFAC         |-->| AREA OF TRIANGLES
00102 !| XMUL           |-->| MULTIPLICATION FACTOR
00103 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00104 !
00105       USE BIEF, EX_MT06AA => MT06AA
00106 !
00107       IMPLICIT NONE
00108       INTEGER LNG,LU
00109       COMMON/INFO/LNG,LU
00110 !
00111 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00112 !
00113       INTEGER, INTENT(IN) :: NELEM,NELMAX
00114       INTEGER, INTENT(IN) :: IKLE1(NELMAX),IKLE2(NELMAX),IKLE3(NELMAX)
00115 !
00116       DOUBLE PRECISION, INTENT(INOUT) :: A11(*),A12(*),A13(*)
00117       DOUBLE PRECISION, INTENT(INOUT) ::        A22(*),A23(*)
00118       DOUBLE PRECISION, INTENT(INOUT) ::               A33(*)
00119 !
00120       DOUBLE PRECISION, INTENT(IN) :: XMUL
00121       DOUBLE PRECISION, INTENT(IN) :: F(*)
00122 !
00123 !     STRUCTURE OF F
00124       TYPE(BIEF_OBJ), INTENT(IN) :: SF
00125 !
00126       DOUBLE PRECISION, INTENT(IN) :: SURFAC(NELMAX)
00127 !
00128 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00129 !
00130 !     DECLARATIONS SPECIFIC TO THIS SUBROUTINE
00131 !
00132       INTEGER IELMF,IELEM
00133 !
00134       DOUBLE PRECISION SUR12,SUR60,DET1,DET2,F123,F1,F2,F3
00135 !
00136 !-----------------------------------------------------------------------
00137 !
00138       SUR60 = XMUL/60.D0
00139       SUR12 = XMUL/12.D0
00140 !
00141 !-----------------------------------------------------------------------
00142 !
00143       IELMF = SF%ELM
00144 !
00145 !-----------------------------------------------------------------------
00146 !
00147 !  CASE WHERE F IS LINEAR
00148 !
00149       IF(IELMF.EQ.11) THEN
00150 !
00151       DO IELEM = 1 , NELEM
00152 !
00153       F1 = F(IKLE1(IELEM))
00154       F2 = F(IKLE2(IELEM))
00155       F3 = F(IKLE3(IELEM))
00156 !
00157       F123 = F1 + F2 + F3
00158 !
00159       DET1 = SURFAC(IELEM) * SUR60
00160       DET2 = DET1 + DET1
00161 !
00162 !***********************************************************************
00163 !
00164 !  ELEMENTS OFF THE DIAGONAL
00165 !
00166       A12(IELEM) = DET1 * (F123+F123-F3)
00167       A13(IELEM) = DET1 * (F123+F123-F2)
00168       A23(IELEM) = DET1 * (F123+F123-F1)
00169 !
00170 !  DIAGONAL TERMS
00171 !
00172       A11(IELEM) = DET2 * (F123+F1+F1)
00173       A22(IELEM) = DET2 * (F123+F2+F2)
00174       A33(IELEM) = DET2 * (F123+F3+F3)
00175 !
00176       ENDDO ! IELEM
00177 !
00178 !-----------------------------------------------------------------------
00179 !
00180 !  CASE WHERE F IS LINEAR
00181 !
00182       ELSEIF(IELMF.EQ.10) THEN
00183 !
00184       DO IELEM = 1 , NELEM
00185 !
00186       F1 = F(IELEM)
00187 !
00188       DET1 = SURFAC(IELEM) * SUR12
00189       DET2 = DET1 + DET1
00190 !
00191 !***********************************************************************
00192 !
00193 !  ELEMENTS OFF THE DIAGONAL
00194 !
00195       A12(IELEM) = DET1 * F1
00196       A13(IELEM) = DET1 * F1
00197       A23(IELEM) = DET1 * F1
00198 !
00199 !  DIAGONAL TERMS
00200 !
00201       A11(IELEM) = DET2 * F1
00202       A22(IELEM) = DET2 * F1
00203       A33(IELEM) = DET2 * F1
00204 !
00205       ENDDO ! IELEM
00206 !
00207 !     OTHER TYPES OF DISCRETISATION OF F
00208 !
00209 !-----------------------------------------------------------------------
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,'MT06AA (BIEF) :',/,
00216      &         1X,'DISCRETISATION DE F NON PREVUE : ',1I6,
00217      &         1X,'NOM REEL : ',A6)
00218 101     FORMAT(1X,'MT06AA (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       RETURN
00229       END

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